aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ChangeLog.md6
-rw-r--r--LICENSE20
-rw-r--r--README.md77
-rw-r--r--ldapply.cabal28
-rw-r--r--src/Main.hs131
5 files changed, 262 insertions, 0 deletions
diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
index 0000000..6100699
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,6 @@
+0.1.0
+=====
+
+ * Initial release.
+ * Works only with UNIX socket authentication.
+
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..c212ae4
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,20 @@
+Copyright (c) 2017, Zalora South East Asia Pte. Ltd
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..a31f94d
--- /dev/null
+++ b/README.md
@@ -0,0 +1,77 @@
+ldapply
+=======
+
+[LDIF](https://www.ietf.org/rfc/rfc2849.txt) idempotent apply tool.
+This tool is similar to `ldapmodify` with one exception: it's idempotent.
+It was written to help declarative deployments with [NixOS](http://nixos.org/).
+
+
+How it works
+============
+
+1. If change type is not specified, it adds or replaces an entry.
+2. If change type is specified, it acts like normal `ldapmodify`.
+
+
+Requirements
+============
+
+`ldapply` is written in Haskell with [GHC](http://www.haskell.org/ghc/).
+All required Haskell libraries are listed in [ldapply.cabal](ldapply.cabal).
+Use [cabal-install](http://www.haskell.org/haskellwiki/Cabal-Install) to fetch
+and build all pre-requisites automatically.
+
+
+Usage
+=====
+
+Type `ldapply --help` to see usage summary:
+
+ Usage:
+ ldapply [options] LDIF...
+
+ Options:
+ -H <ldapuri> LDAP URL to connect to [default: ldapi:///]
+
+ -h, --help Show this message
+
+
+LDIF example
+============
+
+```LDIF
+dn: dc=nodomain
+objectClass: top
+objectClass: dcObject
+objectClass: organization
+dc: nodomain
+o: Example, Inc.
+
+dn: cn=reader,dc=nodomain
+objectclass: top
+objectclass: organizationalRole
+objectclass: simpleSecurityObject
+cn: reader
+description: Initial description
+userPassword: qwerty123lol
+
+# description will be removed, userPassword changed:
+dn: cn=reader,dc=nodomain
+objectclass: top
+objectclass: simpleSecurityObject
+objectclass: organizationalRole
+cn: reader
+userPassword: foobar12345
+
+# userPassword will be changed:
+dn: cn=reader,dc=nodomain
+changetype: modify
+replace: userPassword
+userPassword: anothersecretstuff
+
+dn: cn=reader,dc=nodomain
+changetype: modify
+replace: description
+description: foo
+```
+
diff --git a/ldapply.cabal b/ldapply.cabal
new file mode 100644
index 0000000..df815ec
--- /dev/null
+++ b/ldapply.cabal
@@ -0,0 +1,28 @@
+name: ldapply
+version: 0.1.0
+synopsis: LDIF idempotent apply tool
+license: MIT
+license-file: LICENSE
+author: Igor Pashev <pashev.igor@gmail.com>
+maintainer: Igor Pashev <pashev.igor@gmail.com>
+copyright: 2017, Zalora South East Asia Pte. Ltd
+category: Network, Text
+build-type: Simple
+cabal-version: >=1.20
+extra-source-files: README.md ChangeLog.md
+
+executable ldapply
+ hs-source-dirs: src
+ main-is: Main.hs
+ default-language: Haskell2010
+ ghc-options: -Wall -static -threaded
+
+ build-depends:
+ base >=4.8 && < 50
+ , bytestring
+ , docopt
+ , interpolatedstring-perl6
+ , LDAP >= 0.7.0
+ , ldif
+ , unordered-containers
+
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
index 0000000..3f13b33
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,131 @@
+{-# LANGUAGE QuasiQuotes #-}
+module Main (
+ main
+) where
+
+import Data.ByteString.Char8 (unpack)
+import Data.Char (toLower)
+import Data.HashMap.Strict (fromListWith, toList)
+import Data.Maybe (fromJust)
+import Data.Version (showVersion)
+import LDAP.Init (ldapSimpleExternalSaslBind, ldapInitialize)
+import LDAP.Modify (LDAPMod(..), LDAPModOp(..), ldapAdd, ldapDelete, ldapModify, list2ldm)
+import LDAP.Search (LDAPScope(LdapScopeBase), SearchAttributes(LDAPAllUserAttrs), LDAPEntry(..), ldapSearch)
+import LDAP.Types (LDAP)
+import Paths_ldapply (version) -- from cabal
+import System.Environment (getArgs)
+import System.Exit (die)
+import Text.InterpolatedString.Perl6 (qc)
+import Text.LDIF.Parser (defaulLDIFConf, parseLDIFFile)
+import Text.LDIF.Printer (dn2str)
+import Text.LDIF.Types (Attribute(..), Value(..), Change(..), LDIF(..), LDIFRecord(..), Modify(..), reDN)
+import qualified System.Console.Docopt.NoTH as O
+
+{--
+ TODO:
+ 1. Streaming from stdin (good for large amount of LDIF data)
+ 2. Simple bind with DN and password
+--}
+
+usage :: String
+usage =
+ "ldapply " ++ showVersion version ++
+ " - LDIF dempotent apply tool" ++ [qc|
+
+Usage:
+ ldapply [options] LDIF...
+
+Options:
+ -H <ldapuri> LDAP URL to connect to [default: ldapi:///]
+
+ -h, --help Show this message
+|]
+
+
+main :: IO ()
+main = do
+ doco <- O.parseUsageOrExit usage
+ args <- O.parseArgsOrExit doco =<< getArgs
+ if args `O.isPresent` O.longOption "help"
+ then putStrLn $ O.usage doco
+ else do
+ let
+ ldifs = O.getAllArgs args $ O.argument "LDIF"
+ ldapUrl = fromJust $ O.getArg args $ O.shortOption 'H'
+ ldap <- ldapInitialize ldapUrl
+ ldapSimpleExternalSaslBind ldap
+ mapM_ (processLDIF ldap) ldifs
+
+
+processLDIF :: LDAP -> FilePath -> IO ()
+processLDIF ldap f = do
+ p <- parseLDIFFile defaulLDIFConf f
+ case p of
+ Left err -> die $ show err
+ Right (LDIF _ rs) -> mapM_ (apply ldap) rs
+
+
+apply :: LDAP -> LDIFRecord -> IO ()
+apply ldap rec = do
+ putStrLn $ "looking for " ++ show (dn rec)
+ entries <- ldapSearch ldap (Just $ dn rec) LdapScopeBase Nothing LDAPAllUserAttrs False
+ case entries of
+ [] -> do
+ putStrLn $ "not found " ++ show (dn rec)
+ update ldap Nothing rec
+ [e] -> do
+ putStrLn $ "found " ++ show (dn rec)
+ update ldap (Just e) rec
+ _ -> die $ "internal error: too many entries in response (only 1 or 0 expected): "
+ ++ show (length entries)
+
+
+update :: LDAP -> Maybe LDAPEntry -> LDIFRecord -> IO ()
+update _ Nothing rec@(ChangeRecord _ _) =
+ die $ "cannot update non-existing entry " ++ show (dn rec)
+
+update ldap (Just _) rec@(ChangeRecord _ ch)= do
+ putStrLn $ "modifing " ++ show (dn rec)
+ change ldap (dn rec) ch
+
+update ldap Nothing rec@(ContentRecord _ av) = do
+ putStrLn $ "adding " ++ show (dn rec)
+ ldapAdd ldap (dn rec) . list2ldm LdapModAdd . collect $ av
+
+update ldap (Just (LDAPEntry _ attrs)) rec@(ContentRecord _ av)= do
+ putStrLn $ "replacing " ++ show (dn rec)
+ ldapModify ldap (dn rec) (replace ++ delete)
+ where
+ replace = list2ldm LdapModReplace newAttrs
+ delete = list2ldm LdapModDelete oldAttrs
+ newAttrs = collect av
+ oldAttrs = [ a | a@(v, _) <- attrs, notElem (low v) $ map fst newAttrs ]
+
+
+change :: LDAP -> String -> Change -> IO ()
+change _ _ ChangeModDN = die "modrdn is not supported"
+change ldap n (ChangeAdd av) = ldapModify ldap n . list2ldm LdapModAdd . collect $ av
+change ldap n (ChangeModify m) = ldapModify ldap n . map mod2mod $ m
+change ldap n ChangeDelete = ldapDelete ldap n
+
+mod2mod :: Modify -> LDAPMod
+mod2mod (ModAdd a vv) = LDAPMod LdapModAdd (attr2str a) (map val2str vv)
+mod2mod (ModDelete a vv) = LDAPMod LdapModDelete (attr2str a) (map val2str vv)
+mod2mod (ModReplace a vv) = LDAPMod LdapModReplace (attr2str a) (map val2str vv)
+
+collect :: [(Attribute, Value)] -> [(String, [String])]
+collect = toList . fromListWith (++) . map (\(a, v) -> (attr2str a, [val2str v]))
+
+attr2str :: Attribute -> String
+attr2str (Attribute a) = low . unpack $ a
+
+val2str :: Value -> String
+val2str (Value v) = unpack v
+val2str (ValueI v) = unpack v
+
+dn :: LDIFRecord -> String
+dn = unpack . dn2str . reDN
+
+low :: String -> String
+low = map toLower
+