Initial version 0.1.00.1.0

1 files changed, 131 insertions, 0 deletions

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
+