From a700dc4208104ed353f4918855e3d8381ac43258 Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Sun, 20 Oct 2019 09:19:49 +0000 Subject: [PATCH] Make the hook config file path include the instance host Before this patch, if you ran more than 1 instance as the same OS user, they'd use the same config file path and overwrite it and cause post hooks to have errors due to wrong config being used. --- src/Darcs/Local/Repository.hs | 21 +++++++++++++-------- src/Data/Git/Local.hs | 27 ++++++++++++++++----------- src/Vervis/Application.hs | 7 ++++--- src/Vervis/Darcs.hs | 6 +++++- src/Vervis/Git.hs | 5 ++++- src/Vervis/Handler/Repo.hs | 4 ++++ src/Vervis/Hook.hs | 34 +++++++++++++++++----------------- 7 files changed, 63 insertions(+), 41 deletions(-) diff --git a/src/Darcs/Local/Repository.hs b/src/Darcs/Local/Repository.hs index 3f91859..36e89a8 100644 --- a/src/Darcs/Local/Repository.hs +++ b/src/Darcs/Local/Repository.hs @@ -34,15 +34,18 @@ import qualified Data.ByteString as B import qualified Data.Text as T import qualified Data.Text.IO as TIO -writeDefaultsFile :: FilePath -> FilePath -> Text -> Text -> IO () -writeDefaultsFile path cmd sharer repo = do +writeDefaultsFile :: FilePath -> FilePath -> Text -> Text -> Text -> IO () +writeDefaultsFile path cmd authority sharer repo = do let file = path "_darcs" "prefs" "defaults" - TIO.writeFile file $ defaultsContent cmd sharer repo + TIO.writeFile file $ defaultsContent cmd authority sharer repo setFileMode file $ ownerReadMode .|. ownerWriteMode where - defaultsContent :: FilePath -> Text -> Text -> Text - defaultsContent hook sharer repo = - T.concat ["apply posthook ", T.pack hook, " ", sharer, " ", repo] + defaultsContent :: FilePath -> Text -> Text -> Text -> Text + defaultsContent hook authority sharer repo = + T.concat + [ "apply posthook " + , T.pack hook, " ", authority, " ", sharer, " ", repo + ] {- initialRepoTree :: FileName -> DirTree B.ByteString @@ -75,18 +78,20 @@ createRepo -> FilePath -- ^ Path of Vervis hook program -> Text + -- ^ Instance HTTP authority + -> Text -- ^ Repo sharer textual ID -> Text -- ^ Repo textual ID -> IO () -createRepo parent name cmd sharer repo = do +createRepo parent name cmd authority sharer repo = do let path = parent name createDirectory path let settings = proc "darcs" ["init", "--no-working-dir", "--repodir", path] (_, _, _, ph) <- createProcess settings ec <- waitForProcess ph case ec of - ExitSuccess -> writeDefaultsFile path cmd sharer repo + ExitSuccess -> writeDefaultsFile path cmd authority sharer repo ExitFailure n -> error $ "darcs init failed with exit code " ++ show n readPristineRoot :: FilePath -> IO (Maybe Int, Hash) diff --git a/src/Data/Git/Local.hs b/src/Data/Git/Local.hs index ade7af1..0afe4be 100644 --- a/src/Data/Git/Local.hs +++ b/src/Data/Git/Local.hs @@ -54,18 +54,21 @@ instance SpecToEventTime GitTime where specToEventTime = specToEventTime . gitTimeUTC specsToEventTimes = specsToEventTimes . fmap gitTimeUTC -hookContent :: FilePath -> Text -> Text -> Text -hookContent hook sharer repo = - T.concat ["#!/bin/sh\nexec ", T.pack hook, " ", sharer, " ", repo] +hookContent :: FilePath -> Text -> Text -> Text -> Text +hookContent hook authority sharer repo = + T.concat + [ "#!/bin/sh\nexec ", T.pack hook + , " ", authority, " ", sharer, " ", repo + ] -writeHookFile :: FilePath -> FilePath -> Text -> Text -> IO () -writeHookFile path cmd sharer repo = do +writeHookFile :: FilePath -> FilePath -> Text -> Text -> Text -> IO () +writeHookFile path cmd authority sharer repo = do let file = path "hooks" "post-receive" - TIO.writeFile file $ hookContent cmd sharer repo + TIO.writeFile file $ hookContent cmd authority sharer repo setFileMode file ownerModes -initialRepoTree :: FilePath -> Text -> Text -> FileName -> DirTree Text -initialRepoTree hook sharer repo dir = +initialRepoTree :: FilePath -> Text -> Text -> Text -> FileName -> DirTree Text +initialRepoTree hook authority sharer repo dir = Dir dir [ Dir "branches" [] , File "config" @@ -77,7 +80,7 @@ initialRepoTree hook sharer repo dir = "Unnamed repository; edit this file to name the repository." , File "HEAD" "ref: refs/heads/master" , Dir "hooks" - [ File "post-receive" $ hookContent hook sharer repo + [ File "post-receive" $ hookContent hook authority sharer repo ] , Dir "info" [ File "exclude" "" @@ -105,12 +108,14 @@ createRepo -> FilePath -- ^ Path of Vervis hook program -> Text + -- ^ Instance HTTP authority + -> Text -- ^ Repo sharer textual ID -> Text -- ^ Repo textual ID -> IO () -createRepo path name cmd sharer repo = do - let tree = path :/ initialRepoTree cmd sharer repo name +createRepo path name cmd authority sharer repo = do + let tree = path :/ initialRepoTree cmd authority sharer repo name result <- writeDirectoryWith TIO.writeFile tree let errs = failures $ dirTree result when (not . null $ errs) $ diff --git a/src/Vervis/Application.hs b/src/Vervis/Application.hs index 25e260a..904b22f 100644 --- a/src/Vervis/Application.hs +++ b/src/Vervis/Application.hs @@ -61,13 +61,13 @@ import Yesod.Persist.Core import Yesod.Static import qualified Data.Text as T (unpack) -import qualified Data.HashMap.Strict as M (empty) import Database.Persist.Schema.PostgreSQL (schemaBackend) import Yesod.Mail.Send (runMailer) import Control.Concurrent.ResultShare import Data.KeyFile +import Network.FedURI import Yesod.MonadSite import Control.Concurrent.Local @@ -187,8 +187,8 @@ makeFoundation appSettings = do -- Perform database migration using our application's logging settings. --runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc + let hLocal = appInstanceHost appSettings flip runWorker app $ runSiteDB $ do - let hLocal = appInstanceHost appSettings r <- migrateDB hLocal hashidsCtx case r of Left err -> do @@ -202,7 +202,8 @@ makeFoundation appSettings = do writePostReceiveHooks writePostApplyHooks - writeHookConfig Config + let hostString = T.unpack $ renderAuthority hLocal + writeHookConfig hostString Config { configSecret = hookSecretText appHookSecret , configPort = fromIntegral $ appPort appSettings , configMaxCommits = 20 diff --git a/src/Vervis/Darcs.hs b/src/Vervis/Darcs.hs index 4ac47b3..ab37706 100644 --- a/src/Vervis/Darcs.hs +++ b/src/Vervis/Darcs.hs @@ -63,6 +63,8 @@ import qualified Database.Esqueleto as E import qualified Development.Darcs.Internal.Patch.Parser as P +import Network.FedURI +import Yesod.ActivityPub import Yesod.MonadSite import Darcs.Local.Repository @@ -334,6 +336,8 @@ writePostApplyHooks = do E.where_ $ r E.^. RepoVcs E.==. E.val VCSDarcs return (s E.^. SharerIdent, r E.^. RepoIdent) hook <- asksSite $ appPostApplyHookFile . appSettings + authority <- asksSite $ renderAuthority . siteInstanceHost for_ repos $ \ (E.Value shr, E.Value rp) -> do path <- askRepoDir shr rp - liftIO $ writeDefaultsFile path hook (shr2text shr) (rp2text rp) + liftIO $ + writeDefaultsFile path hook authority (shr2text shr) (rp2text rp) diff --git a/src/Vervis/Git.hs b/src/Vervis/Git.hs index db30030..6dffb97 100644 --- a/src/Vervis/Git.hs +++ b/src/Vervis/Git.hs @@ -67,6 +67,8 @@ import qualified Data.Text.Encoding.Error as TE (lenientDecode) import qualified Data.Vector as V (fromList) import qualified Database.Esqueleto as E +import Network.FedURI +import Yesod.ActivityPub import Yesod.MonadSite import Data.ByteString.Char8.Local (takeLine) @@ -339,6 +341,7 @@ writePostReceiveHooks = do E.where_ $ r E.^. RepoVcs E.==. E.val VCSGit return (s E.^. SharerIdent, r E.^. RepoIdent) hook <- asksSite $ appPostReceiveHookFile . appSettings + authority <- asksSite $ renderAuthority . siteInstanceHost for_ repos $ \ (E.Value shr, E.Value rp) -> do path <- askRepoDir shr rp - liftIO $ writeHookFile path hook (shr2text shr) (rp2text rp) + liftIO $ writeHookFile path hook authority (shr2text shr) (rp2text rp) diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs index 3a3edd1..f6f5667 100644 --- a/src/Vervis/Handler/Repo.hs +++ b/src/Vervis/Handler/Repo.hs @@ -86,6 +86,7 @@ import qualified Data.Text.Lazy.Encoding as L (decodeUtf8With) import qualified Database.Esqueleto as E import Data.MediaType +import Network.FedURI import Web.ActivityPub hiding (Repo) import Yesod.ActivityPub import Yesod.FedURI @@ -145,6 +146,7 @@ postReposR user = do liftIO $ createDirectoryIfMissing True parent let repoName = unpack $ CI.foldedCase $ unRpIdent $ nrpIdent nrp + host <- asksSite siteInstanceHost case nrpVcs nrp of VCSDarcs -> do hook <- getsYesod $ appPostApplyHookFile . appSettings @@ -153,6 +155,7 @@ postReposR user = do parent repoName hook + (renderAuthority host) (shr2text user) (rp2text $ nrpIdent nrp) VCSGit -> do @@ -162,6 +165,7 @@ postReposR user = do parent repoName hook + (renderAuthority host) (shr2text user) (rp2text $ nrpIdent nrp) pid <- requireAuthId diff --git a/src/Vervis/Hook.hs b/src/Vervis/Hook.hs index be200ec..d27243c 100644 --- a/src/Vervis/Hook.hs +++ b/src/Vervis/Hook.hs @@ -149,15 +149,15 @@ instance FromJSON Push instance ToJSON Push -getVervisCachePath :: IO FilePath -getVervisCachePath = getXdgDirectory XdgCache "vervis" +getVervisCachePath :: String -> IO FilePath +getVervisCachePath host = ( host) <$> getXdgDirectory XdgCache "vervis" hookConfigFileName :: String hookConfigFileName = "hook-config.json" -writeHookConfig :: Config -> IO () -writeHookConfig config = do - cachePath <- getVervisCachePath +writeHookConfig :: String -> Config -> IO () +writeHookConfig host config = do + cachePath <- getVervisCachePath host createDirectoryIfMissing True cachePath encodeFile (cachePath hookConfigFileName) config @@ -306,17 +306,17 @@ reportNewCommits config sharer repo = do postReceive :: IO () postReceive = do - cachePath <- getVervisCachePath + (host, sharer, repo) <- do + args <- getArgs + case args of + [h, s, r] -> return (h, T.pack s, T.pack r) + _ -> die "Unexpected number of arguments" + cachePath <- getVervisCachePath host config <- do mc <- decodeFileStrict' $ cachePath hookConfigFileName case mc of Nothing -> die "Parsing hook config failed" Just c -> return c - args <- getArgs - (sharer, repo) <- - case args of - [s, r] -> return (T.pack s, T.pack r) - _ -> die "Unexpected number of arguments" reportNewCommits config sharer repo reportNewPatches :: Config -> Text -> Text -> IO () @@ -416,15 +416,15 @@ reportNewPatches config sharer repo = do postApply :: IO () postApply = do - cachePath <- getVervisCachePath + (host, sharer, repo) <- do + args <- getArgs + case args of + [h, s, r] -> return (h, T.pack s, T.pack r) + _ -> die "Unexpected number of arguments" + cachePath <- getVervisCachePath host config <- do mc <- decodeFileStrict' $ cachePath hookConfigFileName case mc of Nothing -> die "Parsing hook config failed" Just c -> return c - args <- getArgs - (sharer, repo) <- - case args of - [s, r] -> return (T.pack s, T.pack r) - _ -> die "Unexpected number of arguments" reportNewPatches config sharer repo