diff options
| -rw-r--r-- | ChangeLog.md | 6 | ||||
| -rw-r--r-- | LICENSE | 20 | ||||
| -rw-r--r-- | README.md | 77 | ||||
| -rw-r--r-- | ldapply.cabal | 28 | ||||
| -rw-r--r-- | src/Main.hs | 131 |
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. + @@ -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 + |