Initial version 0.1.00.1.0

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
+