diff --git a/.gitignore b/.gitignore index 477a353..a8db177 100644 --- a/.gitignore +++ b/.gitignore @@ -5,3 +5,6 @@ cabal-dev *.chi *.chs.h .virthualenv +.dist-buildwrapper +.project +*flymake.hs diff --git a/Acl.hs b/Acl.hs index 118ad42..6e081d3 100644 --- a/Acl.hs +++ b/Acl.hs @@ -14,16 +14,16 @@ import Text.ParserCombinators.Parsec dquote = char '"' "double quote" quoted_char = try (do - char '\\' + _ <- char '\\' r <- char '"' return r "quoted_char" ) qtext = many( quoted_char <|> noneOf "\"") quoted_string = do - dquote + _ <- dquote r <- qtext - dquote + _ <- dquote return r "quoted string" @@ -58,7 +58,7 @@ instance Show Acl where privName x = case x of { ('a') -> "INSERT"; ('r') -> "SELECT"; ('w')->"UPDATE"; ('d')->"DELETE" ; ('D') -> "TRUNCATE"; ('x') -> "REFERENCES"; ('t') -> "TRIGGER"; ('X')->"EXECUTE" - ; ('U') -> "USAGE"; ('C') -> "CREATE"; ('T')->"CREATE TEMP"; ('c')->"CONNECT"; otherwise ->"? "++[x] } + ; ('U') -> "USAGE"; ('C') -> "CREATE"; ('T')->"CREATE TEMP"; ('c')->"CONNECT"; _ ->"? "++[x] } toAcl x = let (p,q) = (break ('/'==) x) (a,b) = (break ('='==) p) @@ -82,7 +82,7 @@ instance Show (Comparison Acl) where showAclDiffs a b = let dc = dbCompare a b - ddc = filter (\l -> case l of { Equal _ -> False; otherwise -> True }) dc + ddc = filter (\l -> case l of { Equal _ -> False; _ -> True }) dc in if ( a /= b) then concat [ setAttr bold, "\n acls: ", treset, "\n ", intercalate "\n " $ map show ddc] else "" diff --git a/Config.hs b/Config.hs new file mode 100755 index 0000000..58b5e12 --- /dev/null +++ b/Config.hs @@ -0,0 +1,51 @@ +#!/usr/bin/env runhaskell + +module Config where + +import System.IO +import System.Environment +import Control.Monad +import Text.Parsec +import Text.Printf (printf) +import Data.Either (rights) +import Data.Char (isSpace) +import Data.List (unionBy) + +tkc x = spaces >> char x + +optionx = do + z <- notFollowedBy (char '#') + a <- spaces + k <- many1 (noneOf "= ") + c <- tkc '=' + spaces + v <- xstring <|> many1 (satisfy (\x -> not ((isSpace x) || x == '#' ))) + j <- comment + return (OptionSetting k v (uncomment j)) + +data PostgresConf = Comment String | OptionSetting String String String + +uncomment (Comment x) = x + +instance Show PostgresConf where +-- show (Comment s) = if null s then s else "#" ++ s + show (Comment s) = "" + show (OptionSetting k v c) = k ++ " = " ++ (if any (`elem` v) " /#_$,-" then "'"++v++"'" else v) ++ (if null c then "" else " #" ++ c) ++ "\n" + +xstring = between (char '\'') (char '\'') (many (noneOf "'")) +comment = do { spaces; b <- try $ do { char '#'; a <- many (noneOf ""); eof; return a } <|> (eof >> return "") ; return (Comment b) } +optl = try comment <|> optionx + +kwp = do { k <- spaces >> many1 (noneOf "= "); char '='; v <- many (noneOf ""); eof; return (OptionSetting k v "" ) } + +opteq (OptionSetting x _ _ ) (OptionSetting y _ _) = x == y +opteq _ _ = False + +main = do + f:g <- getArgs + let nn = map (parse kwp "Config") g + + h <- openFile f ReadMode + a <- liftM lines $ hGetContents h + let z = map (parse optl "Config") a + mapM_ putStr (map show (unionBy opteq (rights nn) (rights z))) diff --git a/Index.hs b/Index.hs index 056324d..2a73577 100644 --- a/Index.hs +++ b/Index.hs @@ -85,6 +85,8 @@ instance Comparable DbView where if (acl a == acl b && compareIgnoringWhiteSpace (definition a) (definition b)) then Equal a else Unequal a b + +compareViews:: (String -> IO [PgResult], String -> IO [PgResult]) -> IO [Comparison DbView] compareViews (get1, get2, schemas) = do aa <- get1 viewList -- aac <- get1 viewColumns diff --git a/PgSchemaDiff.hs b/PgSchemaDiff.hs index c6f72f3..77a69af 100644 --- a/PgSchemaDiff.hs +++ b/PgSchemaDiff.hs @@ -1,9 +1,8 @@ -{-# LANGUAGE FlexibleInstances, QuasiQuotes #-} +{-# LANGUAGE FlexibleInstances, QuasiQuotes, OverloadedStrings #-} -import Database.HDBC -import Database.HDBC.PostgreSQL +import PostgreSQL import System.Environment -import Acl +-- import Acl import Proc import View -- import XferData @@ -11,8 +10,17 @@ import View -- import UDT import Trigger import Util +-- import qualified MD5 +-- import qualified Crypto.Hash.MD5 as MD5 +-- import MD5 + import Str +-- import qualified Data.ByteString as B +-- import qualified Data.Text.Encoding as T +-- import qualified Data.Text as T + +import Debug.Trace schemaList = [str| SELECT n.nspname AS "Name" @@ -22,23 +30,24 @@ WHERE n.nspname !~ '^pg_' AND n.nspname <> 'information_schema' ORDER BY 1; |] + initialize args = do - let conns1 = head args - let conns2 = (head . tail) args - let restArgs = (drop 2 args) - - conn1 <- connectPostgreSQL conns1 - conn2 <- connectPostgreSQL conns2 - let get1 x = quickQuery' conn1 x [] - let get2 x = quickQuery' conn2 x [] - ra <- ( if (null restArgs) then do + let (conns1 : conns2 : restArgs ) = args + + conn1 <- connectToDb conns1 + conn2 <- connectToDb conns2 + + let get1 x = doQuery conn1 (Query x) + let get2 x = doQuery conn2 (Query x) + ra <- if null restArgs then do sn1 <- get1 schemaList - return $ (map (gs . head) sn1) - else do return restArgs) + let (ResultSet fd ds _) = sn1 + return $ map (stringField . head) ds + else return restArgs - let searchPath = "set search_path="++ (intercalate "," ra) - run conn1 searchPath [] - run conn2 searchPath [] + let searchPath = "set search_path="++ intercalate "," ra + get1 searchPath + get2 searchPath return (get1, get2) {- The command line arguments are: diff --git a/Proc.hs b/Proc.hs index a41f205..e22a046 100644 --- a/Proc.hs +++ b/Proc.hs @@ -2,12 +2,16 @@ module Proc where +import PostgreSQL import Str(str) import Acl import Util -import Console import Diff +import qualified Data.ByteString as B +import Data.Maybe + +functionList :: String functionList = [str| SELECT n.nspname as "Schema", p.proname as "Name", @@ -31,8 +35,22 @@ ORDER BY 1, 2, 3; data DbProc = DbProc { schema :: String, name :: String, argTypes :: String, resType :: String, ptype :: String, source :: String, acl :: [Acl] } deriving(Show, Eq) -mkdbp (a:b:c:d:e:f:g:_) = DbProc a b c d e f (cvtacl g) +-- FieldValue is Maybe ByteString +mkdbp :: [FieldValue] -> DbProc +mkdbp (s : n : a : r : p : src : acl : _ ) = DbProc { + schema = stringField s, + name = stringField n, + argTypes = stringField a, + resType = stringField r, + ptype = stringField p, + source = stringField src, + acl = cvtacl (stringField acl) + } + +-- mkdbp (a:b:c:d:e:f:g:_) = DbProc a b c d e f (cvtacl g) + +showProc :: DbProc -> String showProc x = (schema x) ++ "." ++ (name x) ++ "(" ++ (argTypes x) ++ ")" instance Show (Comparison DbProc) where @@ -50,13 +68,19 @@ instance Comparable DbProc where objCmp a b = if (resType a == resType b && acl a == acl b && compareIgnoringWhiteSpace (source a) (source b)) then Equal a else Unequal a b - + +compareProcs :: (String -> IO PgResult, String -> IO PgResult) -> IO [Comparison DbProc] compareProcs (get1, get2) = do aa <- get1 functionList - let a = map (mkdbp . (map gs)) aa + let (ResultSet _ aa1 _) = aa +-- here I have: RowDescription, [DataRow], CommandComplete ===> ResultSet + + let a = map mkdbp aa1 bb <- get2 functionList - let b = map (mkdbp . (map gs)) bb + let (ResultSet _ bb1 _) = bb + + let b = map mkdbp bb1 let cc = dbCompare a b diff --git a/TestPostgres.hs b/TestPostgres.hs new file mode 100644 index 0000000..b5a15c8 --- /dev/null +++ b/TestPostgres.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE QuasiQuotes, OverloadedStrings #-} + +import System.Environment (getArgs) +import PostgreSQL + +import Str + +import qualified Data.ByteString as B +import qualified Data.Text.Encoding as T +import qualified Data.Text as T + +import Debug.Trace + +main = do + (cs : args) <- getArgs + + conn <- connectToDb cs + + let get1 x = doQuery conn (Query x) + + let schemaList = [str| +SELECT n.nspname AS "Name" +-- ,pg_catalog.pg_get_userbyid(n.nspowner) AS "Owner" +FROM pg_catalog.pg_namespace n +WHERE n.nspname !~ '^pg_' AND n.nspname <> 'information_schema' +ORDER BY 1; +|] + +-- let searchPath = "set search_path="++ (intercalate "," ra) + sl <- get1 schemaList + print sl + + + + diff --git a/Trigger.hs b/Trigger.hs index 7bfdb64..ee0b0b9 100644 --- a/Trigger.hs +++ b/Trigger.hs @@ -2,11 +2,13 @@ module Trigger where +import PostgreSQL import Str(str) import Util -import Console import Diff import Data.Bits +import Data.ByteString (ByteString) +import Data.Maybe import Debug.Trace triggerList = [str| @@ -39,7 +41,16 @@ data DbTrigger = DbTrigger { schema :: String, relation :: String, name :: Strin procedure :: String, definition :: String } deriving(Show) -mkdbt (a:b:c:d:e:f:g:_) = DbTrigger (gs a) (gs b) (gs c) (mktt (gi d)) (gb e) (gs f) (gs g) +mkdbt :: [FieldValue] -> DbTrigger +mkdbt (s : r : n : t : e : p : src : _ ) = DbTrigger { + schema = stringField s, + relation = stringField r, + name = stringField n, + triggerType = mktt (intField t), + enabled = boolField e, + procedure = stringField p, + definition = stringField src +} instance Show (Comparison DbTrigger) where show (Equal x) = concat [sok, showTrigger x, treset] @@ -55,19 +66,24 @@ instance Comparable DbTrigger where if compareIgnoringWhiteSpace (definition a) (definition b) then Equal a else Unequal a b + +compareTriggers :: (String -> IO PgResult, String -> IO PgResult) -> IO [Comparison DbTrigger] compareTriggers (get1, get2) = do aa <- get1 triggerList + let (ResultSet _ aa1 _) = aa + print aa -- aac <- get1 viewColumns -- aat <- get1 viewTriggers -- aar <- get1 viewRules bb <- get2 triggerList + let (ResultSet _ bb1 _) = bb -- bbc <- get2 viewColumns -- bbt <- get2 viewTriggers -- bbr <- get2 viewRules - let a = map mkdbt aa - let b = map mkdbt bb + let a = map mkdbt aa1 + let b = map mkdbt bb1 let cc = dbCompare a b let cnt = dcount iseq cc diff --git a/Util.hs b/Util.hs index 44a372d..a249ee7 100644 --- a/Util.hs +++ b/Util.hs @@ -8,12 +8,22 @@ module Util ( where -import Database.HDBC -import Database.HDBC.PostgreSQL +import PostgreSQL import Console import Data.List (intercalate) import Data.Char (isSpace) +gs :: PgResult -> String +gs = undefined + +gi :: PgResult -> Int +gi = undefined + +gb :: PgResult -> Bool +gb = undefined + + +{- gs :: SqlValue -> String gs y@(SqlByteString x) = fromSql y gs SqlNull = "" @@ -23,12 +33,16 @@ gb y@(SqlBool x) = fromSql y gi :: SqlValue -> Int gi y@(SqlInt32 x) = fromSql y +-} data Comparison a = Equal a | LeftOnly a | RightOnly a | Unequal a a +sok :: String sok = concat [ setColor dullGreen, [charCheck] , " "] +nok :: String nok = concat [setColor dullRed, setAttr bold, [charNotEquals], " "] +trim :: String -> String trim [] = [] trim x@(a:y) = if (isSpace a) then trim y else x @@ -43,7 +57,7 @@ compareIgnoringWhiteSpace x y = ciws (trim x) (trim y) count x a = foldl (flip ((+) . fromEnum . x)) 0 a dcount x y = foldl (\(a,b) z -> if (x z) then (a+1,b) else (a,b+1)) (0,0) y -iseq x = case x of { Equal _ -> True; otherwise -> False } +iseq x = case x of { Equal _ -> True; _ -> False } class Ord a => Comparable a where -- doDbCompare :: [a] -> [a] -> [Comparison a] diff --git a/View.hs b/View.hs index d368721..39d158a 100644 --- a/View.hs +++ b/View.hs @@ -5,11 +5,15 @@ module View where import Str(str) import Acl import Util -import Console import Diff +import PostgreSQL +import Data.Maybe +import qualified Data.ByteString as B + -- LEFT JOIN pg_catalog.pg_class dc ON (d.classoid=dc.oid AND dc.relname='pg_class') -- LEFT JOIN pg_catalog.pg_namespace dn ON (dn.oid=dc.relnamespace AND dn.nspname='pg_catalog') +viewList :: String viewList = [str| SELECT n.nspname AS "Schema", c.relname AS "Name", -- d.description AS "Comment", pg_get_viewdef(c.oid) AS definition, @@ -67,7 +71,15 @@ ORDER BY 1,2,3 data DbView = DbView { schema :: String, name :: String, definition :: String, acl :: [Acl] } deriving(Show) -mkdbv (a:b:c:d:_) = DbView a b c (cvtacl d) + +mkdbv :: [FieldValue] -> DbView +mkdbv (s : n : src : acl : _ ) = DbView { + schema = stringField s, + name = stringField n, + definition = stringField src, + acl = cvtacl (stringField acl) +} + instance Show (Comparison DbView) where show (Equal x) = concat [sok, showView x, treset] @@ -87,17 +99,19 @@ instance Comparable DbView where compareViews (get1, get2) = do aa <- get1 viewList + let (ResultSet _ aa1 _) = aa -- aac <- get1 viewColumns -- aat <- get1 viewTriggers -- aar <- get1 viewRules bb <- get2 viewList + let (ResultSet _ bb1 _ ) = bb -- bbc <- get2 viewColumns -- bbt <- get2 viewTriggers -- bbr <- get2 viewRules - let a = map (mkdbv . (map gs)) aa - let b = map (mkdbv . (map gs)) bb + let a = map mkdbv aa1 + let b = map mkdbv bb1 let cc = dbCompare a b let cnt = dcount iseq cc @@ -106,6 +120,7 @@ compareViews (get1, get2) = do putStr $ treset return $ filter (not . iseq) cc +showView :: DbView -> String showView x = (schema x) ++ "." ++ (name x) instance Ord DbView where diff --git a/XferData.hs b/XferData.hs new file mode 100644 index 0000000..c6e9c0c --- /dev/null +++ b/XferData.hs @@ -0,0 +1,89 @@ +{-# LANGUAGE QuasiQuotes, FlexibleInstances #-} + +module XferData where + +import Str(str) +import Acl +import Util +import Console +import Diff + + -- LEFT JOIN pg_catalog.pg_class dc ON (d.classoid=dc.oid AND dc.relname='pg_class') + -- LEFT JOIN pg_catalog.pg_namespace dn ON (dn.oid=dc.relnamespace AND dn.nspname='pg_catalog') +tableList = [str| +SELECT n.nspname AS "Schema", c.relname AS "Name", -- d.description AS "Comment", + pg_get_viewdef(c.oid) AS definition, + relacl AS "ACLs" +FROM pg_catalog.pg_namespace n + JOIN pg_catalog.pg_class c ON c.relnamespace = n.oid + LEFT JOIN pg_catalog.pg_description d ON (c.oid = d.objoid AND d.objsubid = 0) +WHERE n.nspname IN (select * from unnest(current_schemas(false))) + AND c.relkind = 'v' + AND c.relkind = 'v' + AND n.nspname !~ '^pg_' + AND n.nspname <> 'information_schema' +ORDER BY 1, 2 +|] + +viewColumns = [str| +SELECT n.nspname as "Schema",c.relname AS "View",a.attname AS "Column",a.atttypid AS "Type", + a.attnotnull OR (t.typtype = 'd' AND t.typnotnull) AS attnotnull, + a.atttypmod,a.attlen,row_number() OVER (PARTITION BY a.attrelid ORDER BY a.attnum) AS attnum, + pg_catalog.pg_get_expr(def.adbin, def.adrelid) AS adsrc, + dsc.description,t.typbasetype,t.typtype +FROM pg_catalog.pg_namespace n + JOIN pg_catalog.pg_class c ON (c.relnamespace = n.oid) + JOIN pg_catalog.pg_attribute a ON (a.attrelid=c.oid) + JOIN pg_catalog.pg_type t ON (a.atttypid = t.oid) + LEFT JOIN pg_catalog.pg_attrdef def ON (a.attrelid=def.adrelid AND a.attnum = def.adnum) + LEFT JOIN pg_catalog.pg_description dsc ON (c.oid=dsc.objoid AND a.attnum = dsc.objsubid) + LEFT JOIN pg_catalog.pg_class dc ON (dc.oid=dsc.classoid AND dc.relname='pg_class') + LEFT JOIN pg_catalog.pg_namespace dn ON (dc.relnamespace=dn.oid AND dn.nspname='pg_catalog') +WHERE a.attnum > 0 AND NOT a.attisdropped + AND n.nspname IN (select * from unnest(current_schemas(false))) +ORDER BY 1,2,3 +|] + +viewTriggers = [str| +SELECT n.nspname as "Schema", c.relname AS "View", t.tgname AS "Name", t.tgenabled = 'O' AS enabled, + -- pg_get_triggerdef(trig.oid) as source + concat (np.nspname, '.', p.proname) AS procedure +FROM pg_catalog.pg_trigger t +JOIN pg_catalog.pg_class c ON t.tgrelid = c.oid +JOIN pg_catalog.pg_namespace n ON c.relnamespace = n.oid +JOIN pg_catalog.pg_proc p ON t.tgfoid = p.oid +JOIN pg_catalog.pg_namespace np ON p.pronamespace = np.oid +WHERE t.tgconstraint = 0 AND n.nspname IN (select * from unnest(current_schemas(false))) +ORDER BY 1,2,3 +|] + +viewRules = [str| +SELECT n.nspname as "Schema", c.relname AS "View", r.rulename AS "Name", pg_get_ruledef(r.oid) AS definition +FROM pg_rewrite r +JOIN pg_class c ON c.oid = r.ev_class +JOIN pg_namespace n ON c.relnamespace = n.oid +WHERE n.nspname IN (select * from unnest(current_schemas(false))) AND c.relkind = 'v' +ORDER BY 1,2,3 +|] + +xferData (get1, get2) = do + aa <- get1 viewList + -- aac <- get1 viewColumns + -- aat <- get1 viewTriggers + -- aar <- get1 viewRules + + bb <- get2 viewList + -- bbc <- get2 viewColumns + -- bbt <- get2 viewTriggers + -- bbr <- get2 viewRules + + let a = map (mkdbv . (map gs)) aa + let b = map (mkdbv . (map gs)) bb + + let cc = dbCompare a b + let cnt = dcount iseq cc + putStr $ if (fst cnt > 0) then sok ++ (show $ fst cnt) ++ " matches, " else "" + putStrLn $ if (snd cnt > 0) then concat [setColor dullRed,show $ snd cnt," differences"] else concat [sok,"no differences"] + putStr $ treset + return $ filter (not . iseq) cc + diff --git a/pg-schema-diff.cabal b/pg-schema-diff.cabal index 00c100c..42696a2 100644 --- a/pg-schema-diff.cabal +++ b/pg-schema-diff.cabal @@ -1,13 +1,22 @@ Name: pg-schema-diff Version: 0.1 -Cabal-Version: >= 1.2 +Cabal-Version: >= 1.18 License: PublicDomain Author: r0ml Synopsis: Compare two sets of Postgres schemas and show the differences Build-Type: Simple Executable pg_schema_diff - Build-Depends: template-haskell, base, array, parsec, HDBC, HDBC-postgresql + Build-Depends: template-haskell, postgrehs, base, array, bytestring, text, parsec Main-Is: PgSchemaDiff.hs - Ghc-options: -Wall + Ghc-options: -Wall Hs-Source-Dirs: . + Default-Language: Haskell2010 + +Executable test_postgres + Build-Depends: template-haskell, base, array, bytestring, text, postgrehs + Main-Is: TestPostgres.hs + Ghc-options: -Wall + Hs-Source-Dirs: . + Default-Language: Haskell2010 +