keter 0.3.4 → 0.3.4.1

raw patch · 3 files changed

+30/−8 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Keter/App.hs +18/−4
• Keter/TempFolder.hs +11/−3
• keter.cabal +1/−1

@@ -23,6 +23,7 @@ import qualified Codec.Archive.Tar.Entry as Tar import Codec.Compression.GZip (decompress) import qualified Filesystem.Path.CurrentOS as F+import qualified Filesystem as F import Data.Yaml import Control.Applicative ((<$>), (<*>)) import qualified Network@@ -40,6 +41,7 @@ import Data.Text.Encoding (encodeUtf8) import System.Posix.Types (UserID, GroupID) import System.Posix.Files.ByteString (setOwnerAndGroup, setFdOwnerAndGroup)+import Control.Monad (unless)  data Config = Config     { configExec :: F.FilePath@@ -101,7 +103,7 @@     case elbs of         Left e -> return $ Left e         Right lbs -> do-            edir <- getFolder tf appname+            edir <- getFolder muid tf appname             case edir of                 Left e -> return $ Left e                 Right dir -> do@@ -133,6 +135,19 @@     fp0 = shRoot sh     fp = F.collapse $ dir F.</> "config" F.</> fp0 +-- | Create a directory tree, setting the uid and gid of all newly created+-- folders.+createTreeUID :: UserID -> GroupID -> FilePath -> IO ()+createTreeUID uid gid =+    go+  where+    go fp = do+        exists <- F.isDirectory fp+        unless exists $ do+            go $ F.parent fp+            F.createDirectory False fp+            setOwnerAndGroup (F.encode fp) uid gid+ unpackTar :: Maybe (UserID, GroupID)           -> FilePath -> Tar.Entries Tar.FormatError -> IO () unpackTar muid dir =@@ -146,10 +161,9 @@         let fp = dir </> decodeString (Tar.entryPath e)         case Tar.entryContent e of             Tar.NormalFile lbs _ -> do-                createTree $ F.directory fp                 case muid of-                    Nothing -> return ()-                    Just (uid, gid) -> setOwnerAndGroup (F.encode $ F.directory fp) uid gid+                    Nothing -> createTree $ F.directory fp+                    Just (uid, gid) -> createTreeUID uid gid $ F.directory fp                 let write fd bs = unsafeUseAsCStringLen bs $ \(ptr, len) -> do                         _ <- fdWriteBuf fd (castPtr ptr) (fromIntegral len)                         return ()

@@ -12,6 +12,9 @@ import Data.Word (Word) import Keter.Postgres (Appname) import qualified Data.IORef as I+import System.Posix.Files.ByteString (setOwnerAndGroup)+import System.Posix.Types (UserID, GroupID)+import qualified Filesystem.Path.CurrentOS as F  data TempFolder = TempFolder     { tfRoot :: FilePath@@ -26,8 +29,13 @@     c <- I.newIORef minBound     return $ TempFolder fp c -getFolder :: TempFolder -> Appname -> KIO (Either SomeException FilePath)-getFolder TempFolder {..} appname = do+getFolder :: Maybe (UserID, GroupID) -> TempFolder -> Appname -> KIO (Either SomeException FilePath)+getFolder muid TempFolder {..} appname = do     !i <- atomicModifyIORef tfCounter $ \i -> (succ i, i)     let fp = tfRoot </> fromText (appname ++ "-" ++ show i)-    liftIO (createTree fp >> return fp)+    liftIO $ do+        createTree fp+        case muid of+            Nothing -> return ()+            Just (uid, gid) -> setOwnerAndGroup (F.encode fp) uid gid+        return fp

@@ -1,5 +1,5 @@ Name:                keter-Version:             0.3.4+Version:             0.3.4.1 Synopsis:            Web application deployment manager, focusing on Haskell web frameworks Description:         Handles deployment of web apps, providing a reverse proxy to achieve zero downtime deployments. For more information, please see the README on Github: <https://github.com/snoyberg/keter#readme> Homepage:            http://www.yesodweb.com/