diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,12 @@ +# Changelog for gargoyle-postgresql + +## 0.2 + +* Bugfix: Replace use of file handle with /dev/null to fix a crash due to lack of referential transparency in GHCs behavior with respect to file Handles +* Loosen version bounds +* Add `gargoyle-pg-run`, which makes it easier to run gargoyle-database-using programs (e.g., psql, pg_dump). +* Enable test suite by default + +## 0.1 + +* Initial release diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,12 @@ +Copyright (c) 2017, Obsidian Systems LLC +All rights reserved. + +Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. + +3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/gargoyle-postgresql.cabal b/gargoyle-postgresql.cabal --- a/gargoyle-postgresql.cabal +++ b/gargoyle-postgresql.cabal @@ -1,13 +1,14 @@ -name: gargoyle-postgresql -version: 0.1 -license: BSD3 -author: Obsidian Systems LLC -maintainer: maintainer@obsidian.systems -copyright: Copyright (C) 2017 Obsidian Systems LLC -category: PostgreSQL -build-type: Simple -cabal-version: >=1.10 -synopsis: Manage PostgreSQL servers with gargoyle +name: gargoyle-postgresql +version: 0.2.0.0 +license: BSD3 +license-file: LICENSE +author: Obsidian Systems LLC +maintainer: maintainer@obsidian.systems +copyright: Copyright (C) 2017 Obsidian Systems LLC +category: PostgreSQL +build-type: Simple +cabal-version: >=1.10 +synopsis: Manage PostgreSQL servers with gargoyle description: This package provides tools for managing PostgreSQL servers that live in local folders and communicate via a Unix domain socket. It uses the package in order to automatically initialize, spin up, and spin down such servers according to client demand. . @@ -31,68 +32,91 @@ > withDb :: String -> (Connection -> IO a) -> IO a > withDb dbPath a = withGargoyle defaultPostgres dbPath $ \dbUri -> a =<< connectPostgreSQL dbUri +extra-source-files: ChangeLog.md +tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.2 + -- Requires postgres to be in the environment to run -flag enable-psql-test +flag disable-psql-test default: False - manual: True + manual: True library - exposed-modules: Gargoyle.PostgreSQL - ghc-options: -Wall - ghc-prof-options: -fprof-auto - build-depends: base >= 4.9 && < 4.11 - , bytestring == 0.10.* - , directory == 1.3.* - , gargoyle == 0.1.* - , process == 1.4.* - , stringsearch == 0.3.* - , text == 1.2.* - , unix == 2.7.* - hs-source-dirs: src + exposed-modules: Gargoyle.PostgreSQL + ghc-options: -Wall + ghc-prof-options: -fprof-auto-exported + build-depends: + base >=4.12 && <4.15 + , bytestring >=0.10 && <0.12 + , directory >=1.3 && <1.4 + , gargoyle ==0.1.1 + , posix-escape >=0.1 && <0.2 + , process >=1.5 && <1.7 + , stringsearch >=0.3 && <0.4 + , text >=1.2 && <1.3 + , unix >=2.7.2 && <2.8 + + hs-source-dirs: src default-language: Haskell2010 executable gargoyle-psql - main-is: gargoyle-psql.hs - hs-source-dirs: src-bin - ghc-options: -Wall -threaded - ghc-prof-options: -fprof-auto + main-is: gargoyle-psql.hs + hs-source-dirs: src-bin + ghc-options: -Wall -threaded + ghc-prof-options: -fprof-auto-exported default-language: Haskell2010 - build-depends: base - , bytestring - , gargoyle - , gargoyle-postgresql - , process - , text - , unix + build-depends: + base + , bytestring + , gargoyle + , gargoyle-postgresql + , process + , text + , unix +executable gargoyle-pg-run + main-is: gargoyle-pg-run.hs + hs-source-dirs: src-bin + ghc-options: -Wall -threaded + ghc-prof-options: -fprof-auto-exported + default-language: Haskell2010 + build-depends: + base + , gargoyle + , gargoyle-postgresql + executable gargoyle-postgres-monitor - main-is: gargoyle-postgres-monitor.hs - hs-source-dirs: src-bin - ghc-options: -Wall -threaded - ghc-prof-options: -fprof-auto + main-is: gargoyle-postgres-monitor.hs + hs-source-dirs: src-bin + ghc-options: -Wall -threaded + ghc-prof-options: -fprof-auto-exported default-language: Haskell2010 - build-depends: base - , bytestring - , gargoyle - , gargoyle-postgresql - , process - , text + build-depends: + base + , bytestring + , gargoyle + , gargoyle-postgresql + , process + , text test-suite gargoyle-psql-test - type: exitcode-stdio-1.0 - main-is: gargoyle-psql-test.hs - ghc-options: -Wall -threaded - ghc-prof-options: -fprof-auto - hs-source-dirs: tests - if !flag(enable-psql-test) + type: exitcode-stdio-1.0 + main-is: gargoyle-psql-test.hs + ghc-options: -Wall -threaded + ghc-prof-options: -fprof-auto-exported + hs-source-dirs: tests + default-language: Haskell2010 + + if flag(disable-psql-test) buildable: False + else - build-depends: base - , bytestring - , directory - , filepath - , gargoyle - , gargoyle-postgresql - , process - , text - , unix + build-depends: + base + , bytestring + , directory + , filepath + , gargoyle + , gargoyle-postgresql + , process + , text + , unix diff --git a/src-bin/gargoyle-pg-run.hs b/src-bin/gargoyle-pg-run.hs new file mode 100644 --- /dev/null +++ b/src-bin/gargoyle-pg-run.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import System.Environment (getArgs, getProgName) +import System.Exit (exitFailure, exitWith) + +import Gargoyle.PostgreSQL (defaultPostgres, runPgLocalWithSubstitution) + +main :: IO () +main = do + args <- getArgs + case args of + dbPath:cmd:cmdArgs -> + exitWith =<< runPgLocalWithSubstitution defaultPostgres dbPath cmd (\conn -> if null cmdArgs then [conn] else substArgs conn cmdArgs) Nothing + _ -> do + pname <- getProgName + putStrLn $ unwords [ "USAGE:", pname, "", "", "[...]" ] + putStrLn "\t: path to local db" + putStrLn "\t: command to run" + putStrLn "\t: list of arguments to where the special argument '{}' is expanded into a connection string; if is empty, '{}' will be supplied as the only argument by default" + exitFailure + where + substArgs conn = map (\x -> if x == "{}" then conn else x) diff --git a/src/Gargoyle/PostgreSQL.hs b/src/Gargoyle/PostgreSQL.hs --- a/src/Gargoyle/PostgreSQL.hs +++ b/src/Gargoyle/PostgreSQL.hs @@ -5,56 +5,62 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Search as BS -import Data.Function +import Data.Foldable (for_) import Data.Maybe -import Data.Monoid import qualified Data.Text as T import qualified Data.Text.Encoding as T import System.Directory import System.Exit import System.IO +import System.Posix.Escape import System.Posix.Signals import System.Process -import System.Process.Internals import Gargoyle -- | A 'Gargoyle' that assumes `initdb` and `postgres` are in the path and -- will perform a 'fast shutdown' on termination (see below). -defaultPostgres :: Gargoyle ProcessHandle ByteString -defaultPostgres = mkPostgresGargoyle "initdb" "postgres" shutdownPostgresFast +defaultPostgres :: Gargoyle FilePath ByteString +defaultPostgres = mkPostgresGargoyle "pg_ctl" shutdownPostgresFast -- | Create a gargoyle by telling it where the relevant PostgreSQL executables are and -- what it should do in order to shut down the server. This module provides two options: -- 'shutdownPostgresSmart' and 'shutdownPostgresFast'. -mkPostgresGargoyle :: FilePath -- ^ Path to `initdb` - -> FilePath -- ^ Path to `postgres` - -> (ProcessHandle -> IO ()) -- ^ Shutdown function - -> Gargoyle ProcessHandle ByteString +mkPostgresGargoyle :: FilePath -- ^ Path to `pg_ctl` + -> (FilePath -> FilePath -> IO ()) -- ^ Shutdown function + -> Gargoyle FilePath ByteString -- ^ The 'Gargoyle' returned provides to client code the connection -- string that can be used to connect to the PostgreSQL server -mkPostgresGargoyle initdbPath postgresPath shutdownFun = Gargoyle +mkPostgresGargoyle pgCtlPath shutdownFun = Gargoyle { _gargoyle_exec = "gargoyle-postgres-monitor" - , _gargoyle_init = initLocalPostgres initdbPath - , _gargoyle_start = startLocalPostgres postgresPath - , _gargoyle_stop = shutdownFun + , _gargoyle_init = initLocalPostgres pgCtlPath + , _gargoyle_start = startLocalPostgres pgCtlPath + , _gargoyle_stop = shutdownFun pgCtlPath , _gargoyle_getInfo = getLocalPostgresConnectionString } -- | Create a new PostgreSQL database in a local folder. This is a low level function used to -- define the PostgreSQL 'Gargoyle'. -initLocalPostgres :: FilePath -- ^ Path to PostgreSQL `initdb` executable +initLocalPostgres :: FilePath -- ^ Path to PostgreSQL `pg_ctl` executable -> FilePath -- ^ Path in which to initialize PostgreSQL Server -> IO () initLocalPostgres binPath dbDir = do - (_, _, _, initdb) <- runInteractiveProcess binPath - [ "-D", dbDir - , "-U", "postgres" - , "--no-locale" - , "-E", "UTF8" - ] Nothing Nothing - ExitSuccess <- waitForProcess initdb - return () + devNull <- openFile "/dev/null" WriteMode + (_, _, _, initdb) <- createProcess (proc binPath + [ "init" + , "-D", dbDir + , "-o", escapeMany + [ "-U", "postgres" + , "--no-locale" + , "-E", "UTF8" + ] + ]) { std_in = NoStream, std_out = UseHandle devNull, std_err = Inherit } + r <- waitForProcess initdb + case r of + ExitSuccess -> return () + _ -> do + putStrLn $ "initLocalPostgres failed: " ++ show r + exitWith r -- | Produces the connection string for a local postgresql database. This is a low level function -- used to define the PostgreSQL 'Gargoyle' @@ -69,44 +75,67 @@ -- | Start a postgres server that is assumed to be in the given folder. This is a low level function -- used to define the PostgreSQL 'Gargoyle' -startLocalPostgres :: FilePath -- ^ Path to PostgreSQL `postgres` executable +startLocalPostgres :: FilePath -- ^ Path to PostgreSQL `pg_ctl` executable -> FilePath -- ^ Path where the server to start is located - -> IO ProcessHandle -- ^ handle of the PostgreSQL server + -> IO FilePath -- ^ handle of the PostgreSQL server startLocalPostgres binPath dbDir = do absoluteDbDir <- makeAbsolute dbDir - (_, _, err, postgres) <- runInteractiveProcess binPath - [ "-h", "" + devNull <- openFile "/dev/null" WriteMode + (_, _, _, postgres) <- createProcess (proc binPath + [ "start" , "-D", absoluteDbDir - , "-k", absoluteDbDir - ] Nothing Nothing - fix $ \loop -> do - l <- hGetLine err - let (tag, rest) = span (/= ':') l - when (tag /= "LOG") $ fail $ "startLocalPostgres: Unexpected output from postgres: " <> show l - when (rest /= ": database system is ready to accept connections") loop - return postgres + , "-w" + , "-o", escapeMany + [ "-h", "" + , "-k", absoluteDbDir + ] + ]) { std_in = NoStream, std_out = UseHandle devNull, std_err = Inherit } + r <- waitForProcess postgres + case r of + ExitSuccess -> return absoluteDbDir + _ -> do + putStrLn $ "startLocalPostgres failed: " <> show r + exitWith r -- | Perform a "Smart Shutdown" of Postgres; -- see http://www.postgresql.org/docs/current/static/server-shutdown.html -shutdownPostgresSmart :: ProcessHandle -- ^ handle of the PostgreSQL server +shutdownPostgresSmart :: FilePath -- ^ Path to PostgreSQL `pg_ctl` executable + -> FilePath -- ^ Path where the server to start is located -> IO () -shutdownPostgresSmart postgres = do - terminateProcess postgres - _ <- waitForProcess postgres - return () +shutdownPostgresSmart = shutdownPostgresWithMode "smart" -- | Perform a "Fast Shutdown" of Postgres; -- see http://www.postgresql.org/docs/current/static/server-shutdown.html -shutdownPostgresFast :: ProcessHandle -- ^ handle of the PostgreSQL server - -> IO () -shutdownPostgresFast postgres = do - withProcessHandle postgres $ \p -> do - case p of - ClosedHandle _ -> return () - OpenHandle h -> signalProcess sigINT h - _ <- waitForProcess postgres - return () +shutdownPostgresFast :: FilePath -- ^ Path to PostgreSQL `pg_ctl` executable + -> FilePath -- ^ Path where the server to start is located + -> IO () +shutdownPostgresFast = shutdownPostgresWithMode "fast" +-- | Perform a "Immediate Shutdown" of Postgres; +-- see http://www.postgresql.org/docs/current/static/server-shutdown.html +shutdownPostgresImmediate :: FilePath -- ^ Path to PostgreSQL `pg_ctl` executable + -> FilePath -- ^ Path where the server to start is located + -> IO () +shutdownPostgresImmediate = shutdownPostgresWithMode "immediate" + +shutdownPostgresWithMode :: String -- ^ The shutdown mode to execute; see https://www.postgresql.org/docs/9.5/app-pg-ctl.html + -> FilePath -- ^ Path to PostgreSQL `pg_ctl` executable + -> FilePath -- ^ Path where the server to start is located + -> IO () +shutdownPostgresWithMode mode binPath absoluteDbDir = do + (_, _, _, postgres) <- createProcess (proc binPath + [ "stop" + , "-D", absoluteDbDir + , "-w" + , "-m", mode + ]) { std_in = NoStream, std_out = NoStream, std_err = Inherit } + r <- waitForProcess postgres + case r of + ExitSuccess -> return () + _ -> do + putStrLn $ "stopLocalPostgres failed: " <> show r + exitWith r + -- | Run `psql` against a Gargoyle managed db. psqlLocal :: Gargoyle pid ByteString -- ^ 'Gargoyle' against which to run -> FilePath -- ^ The path to `psql` @@ -130,3 +159,27 @@ Just input -> hPutStrLn (fromJust mStdin) (input ++ "\n\\q") ExitSuccess <- waitForProcess psql return () + +-- | Run an arbitrary process against a Gargoyle-managed DB, providing connection +-- information by substituting a given argument pattern with the connection string. +runPgLocalWithSubstitution + :: Gargoyle pid ByteString -- ^ 'Gargoyle' against which to run + -> FilePath -- ^ The path where the managed daemon is expected + -> FilePath -- ^ Path to process to run + -> (String -> [String]) -- ^ Function producing arguments to the process given the connection string + -> Maybe String -- ^ Optionally provide stdin input instead of an inheriting current stdin. + -> IO ExitCode +runPgLocalWithSubstitution g dbPath procPath mkProcArgs mInput = withGargoyle g dbPath $ \dbUri -> do + void $ installHandler keyboardSignal Ignore Nothing + let + procSpec = (proc procPath $ mkProcArgs $ T.unpack $ T.decodeUtf8 dbUri) + { std_in = case mInput of + Nothing -> Inherit + Just _ -> CreatePipe + , std_out = Inherit + , std_err = Inherit + } + withCreateProcess procSpec $ \mStdin _ _ procHandle -> do + for_ mInput $ + hPutStrLn (fromMaybe (error "runPgLocalWithSubstitution: input stream was expected") mStdin) + waitForProcess procHandle