ldif 0.0.5 → 0.0.6

raw patch · 13 files changed

+304/−165 lines, 13 filesdep +cmdargsnew-component:exe:ldifmodifyPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: cmdargs

API changes (from Hackage documentation)

Files

• TODO.org +22/−20
• ldif.cabal +9/−2
• src/Text/LDIF.hs +6/−4
• src/Text/LDIF/Apply.hs +54/−0
• src/Text/LDIF/Diff.hs +48/−0
• src/Text/LDIF/Parser.hs +13/−12
• src/Text/LDIF/Printer.hs +21/−25
• src/Text/LDIF/Proc.hs +0/−68
• src/Text/LDIF/Types.hs +15/−11
• src/Text/LDIF/Utils.hs +56/−0
• src/diffLDIF.hs +1/−1
• src/ldif2html.hs +20/−22
• src/ldifmodify.hs +39/−0

@@ -1,22 +1,24 @@-* DONE replace error call in mkMod with parser error-   (Not needed)-* DONE create preprocessor for concat split long lines & remove comments-* DONE refactoring of packages, create Types, Parser and Proc-* TODO update parseDNStr to parse all kind of DN notations-* TODO error handling, modify add: <attrX> and than <attrY>:<value>,-         need to be asserted that <attrX> and <attrY> are the same.-* TODO Implement the base64 parsing-* TODO Implement modifyDN parsing-* TODO update serializers back to LDIF for base64 & all DN notations-* TODO add module tests for versioned LDIFs-* TODO add module tests for base64 parsing-* TODO Implement Attribute Name case-insensitive matching at DN-* TODO Use getopt for input parameters on diffLDIF cmd-* TODO Implement ldifmodify (like ldapmodify)-   offline applying of Change LDIF on Content LDIF-   ldifmodify -h <contentLDIF> -f <changeLDIF> [-o <contentLDIFAfter>] -* DONE Change interface for providing parser method with expected type of LDIF+* Tasks+** update parseDNStr to parse all kind of DN notations+** error handling, modify add: <attrX> and than <attrY>:<value>,+          need to be asserted that <attrX> and <attrY> are the same.+** Implement the base64 parsing+** Implement modifyDN parsing+** update serializers back to LDIF for base64 & all DN notations+** add module tests for versioned LDIFs+** add module tests for base64 parsing+** Use getopt for input parameters on diffLDIF cmd+** TODO Implement ldifmodify (like ldapmodify)+    offline applying of Change LDIF on Content LDIF+    ldifmodify -f <contentLDIF> -o <outputLDIF> [<modifyLDIF> ... ] +* Archive+** DONE Change interface for providing parser method with expected type of LDIF it allows parse changeldif as contentldif regardless the content. -* DONE Add ldif2html which generate hypertext LDIF representation-* DONE Update unwrap method in preprocessor for feasible resource consuption+** DONE Add ldif2html which generate hypertext LDIF representation+** DONE Update unwrap method in preprocessor for feasible resource consuption+** DONE replace error call in mkMod with parser error+    (Not needed)+** DONE create preprocessor for concat split long lines & remove comments+** DONE refactoring of packages, create Types, Parser and Proc+** DONE Implement Attribute Name case-insensitive matching at DN

@@ -1,5 +1,5 @@ Name:            ldif-Version:         0.0.5+Version:         0.0.6 License:         BSD3 License-File:    LICENSE Synopsis:        The LDAP Data Interchange Format (LDIF) parser @@ -54,6 +54,7 @@                    filepath,                    haskell98,                    containers,+                   cmdargs,                    parsec       >= 2.1.0,                    Cabal        >= 1.5 && < 1.9   Hs-Source-Dirs:  src@@ -65,7 +66,9 @@         Text.LDIF.Types         Text.LDIF.Parser         Text.LDIF.Printer-        Text.LDIF.Proc+        Text.LDIF.Utils+        Text.LDIF.Diff+        Text.LDIF.Apply  Executable diffLDIF   Hs-Source-Dirs:  src@@ -74,6 +77,10 @@ Executable ldif2html   Hs-Source-Dirs:  src   Main-Is:         ldif2html.hs++Executable ldifmodify+  Hs-Source-Dirs:  src+  Main-Is:         ldifmodify.hs  Executable test   Hs-Source-Dirs:  src, tests

@@ -2,13 +2,15 @@   module Text.LDIF.Types,   module Text.LDIF.Parser,   module Text.LDIF.Printer,-  module Text.LDIF.Proc+  module Text.LDIF.Utils,+  module Text.LDIF.Diff,+  module Text.LDIF.Apply ) where  import Text.LDIF.Types import Text.LDIF.Parser import Text.LDIF.Printer-import Text.LDIF.Proc--  +import Text.LDIF.Utils+import Text.LDIF.Diff+import Text.LDIF.Apply

@@ -0,0 +1,54 @@+module Text.LDIF.Apply (+        applyLDIF+)+where+import Text.LDIF.Types+import Text.LDIF.Printer+import Text.LDIF.Utils+import Data.Maybe+import Data.Either+import Data.List (nub)++-- | Apply one LDIF to another LDIF. The destination LDIF has+-- | to be Content LDIF+applyLDIF :: LDIF -> LDIF -> LDIF+applyLDIF dst@(LDIFContent _ _) (LDIFChanges _ xs) = foldr (applyRecord2LDIF) dst xs+applyLDIF dst@(LDIFContent _ _) (LDIFContent _ xs) = foldr (applyRecord2LDIF) dst xs+applyLDIF _ _ = error "Destination LDIF has to be Content LDIF and not Change LDIF"++-- | Apply one LDIF Content/Change Record into LDIF and produce Changed LDIF+applyRecord2LDIF :: LDIFRecord -> LDIF -> LDIF+applyRecord2LDIF rec@(ContentRecord dn vals) dst = applyRecord2LDIF (ChangeRecord dn (ChangeAdd vals)) dst+applyRecord2LDIF rec@(ChangeRecord  dn op)   dst = applyChange2Record op dn dst (findRecordByDN dst dn)++-- | Apply one LDIF Change (add/del/modf) for given DN within LDIF Content +applyChange2Record :: Change -> DN -> LDIF -> Maybe LDIFRecord -> LDIF+applyChange2Record (ChangeAdd vals)   dn (LDIFContent v xs) Nothing  = LDIFContent v (xs++[ContentRecord dn vals]) +applyChange2Record (ChangeAdd vals)   dn (LDIFContent v xs) (Just _) = error ("ADD: Already exists: "++(show dn))+applyChange2Record ChangeDelete       dn (LDIFContent v xs) (Just _) = let rn = filter (\x -> dn /= (reDN x)) xs+                                                                       in LDIFContent v rn+applyChange2Record ChangeDelete       dn (LDIFContent v xs) Nothing  = error ("DELETE: Entry not found: "++(show dn))+applyChange2Record (ChangeModify ops) dn (LDIFContent v xs) (Just r) = let pre  = takeWhile (\x -> dn /= (reDN x)) xs+                                                                           post = filter (\x -> dn /= (reDN x)) $ dropWhile (\x -> dn /= (reDN x)) xs+                                                                           rn   = foldr applyMod2Record r ops+                                                                       in LDIFContent v (pre++[rn]++post)+applyChange2Record ChangeModDN      _ _ _  = error "Operation ModDN is not supported"++-- | Apply Attribute Modification (Add/Del/Replace) to ContentRecord and produce changed ContentRecord+applyMod2Record :: Modify -> LDIFRecord -> LDIFRecord+applyMod2Record (ModAdd      name vals) (ContentRecord dn av) = let nav = map (\v -> (name,v)) vals  -- new attr/values+                                                                    mav = av ++ nav                  -- merged attr/values+                                                                    verified = if (length $ nub mav) == (length mav) then mav+                                                                               else error ("ModAdd: Values already exists: "++(show av)++" vs "++(show vals)++" DN:"++(show dn))+                                                                    in ContentRecord dn verified+applyMod2Record (ModDelete   name [])   (ContentRecord dn av) = let nav = filter (\(n,v) -> n /= name) av -- new attr/values+                                                                    verified = if (length $ nub nav) /= (length av) then nav+                                                                               else error ("ModDel: Attribute not found: "++(show name)++" DN:"++(show dn))+                                                                in ContentRecord dn verified+applyMod2Record (ModDelete   name vals) (ContentRecord dn av) = let mav = filter (\(n,v) -> n /= name || v `notElem` vals) av+                                                                    verified = if (length av) - (length mav) == (length vals) then mav+                                                                               else error ("ModDel: Attribute/Value not found: "++(show name)++"vals"++(show vals)++" DN:"++(show dn))+                                                                in ContentRecord dn verified+applyMod2Record (ModReplace  name vals) (ContentRecord dn av) = let nav = map (\v -> (name,v)) vals -- new attr/values+                                                                    mav = (filter (\(n,v) -> n /= name) av) ++ nav -- merged+                                                                in ContentRecord dn mav

@@ -0,0 +1,48 @@+module Text.LDIF.Diff (+        diffLDIF,+        diffRecord+)+where+import Text.LDIF.Types+import Text.LDIF.Utils+import Text.LDIF.Printer+import Data.Maybe+import Data.Either+import Data.List (nub)++-- | Create Change LDIF between to LDIF contents. If any+-- | of input argument is not LDIFContent it returns Nothing. +-- | If there is not difference the Change LDIF with empty+-- | change list is returned.+-- |+-- | Unsing following strategy: +-- | 1. Iterate over L1 DN's and Modify / Remove Content +-- | 2. Iterate over L2 and Add Content not in L1+diffLDIF :: LDIF -> LDIF -> Maybe LDIF+diffLDIF l1@(LDIFContent _ c1) l2@(LDIFContent v2 c2) = Just (LDIFChanges v2 (changes ++ adds))+   where +      adds = map (content2add) $ filter (not . isEntryIn l1) c2+      changes = filter (not . isDummyRecord) $ foldl (processEntry) [] c1+      processEntry xs e1 = let me2 = findRecordByDN l2 (reDN e1) +                               change = case me2 of+					   Nothing -> ChangeRecord (reDN e1) ChangeDelete+                                           Just e2 -> fromJust $ diffRecord e1 e2+                           in xs ++ [change]+      isEntryIn ll ex = let mex = findRecordByDN ll (reDN ex)+                        in case mex of+                          Nothing -> False+                          Just _  -> True+      content2add (ContentRecord dn vals) = ChangeRecord dn (ChangeAdd vals)+diffLDIF _ _ = Nothing++-- | Diff two AttrVal Records if any of provided. +-- | Implementation uses inefficient algorithm for large count of attributes within ContentRecord.+diffRecord :: LDIFRecord -> LDIFRecord -> Maybe LDIFRecord+diffRecord r1 r2 | (reDN r1) /= (reDN r2) = Nothing+                 | otherwise = Just (ChangeRecord (reDN r1) (ChangeModify mods))+   where+      mods = delMods ++ addMods+      addMods = map (\x -> ModAdd (fst x) [(snd x)]) addVals+      delMods = map (\x -> ModDelete (fst x) [(snd x)]) delVals+      addVals = filter (\x -> not $ elem x (coAttrVals r1)) (coAttrVals r2) :: [AttrValue]+      delVals = filter (\x -> not $ elem x (coAttrVals r2)) (coAttrVals r1) :: [AttrValue]

@@ -79,20 +79,20 @@     recs <- sepEndBy1 pAttrValRec pSEPs     return $ LDIFContent ver recs -pAttrValRec ::  CharParser st ContentRecord+pAttrValRec ::  CharParser st LDIFRecord pAttrValRec = do     dn <- pDNSpec     pSEP     attrVals <- sepEndBy1 pAttrValSpec pSEP     return $ ContentRecord dn attrVals -pChangeRec :: CharParser st ChangeRecord+pChangeRec :: CharParser st LDIFRecord pChangeRec = try pChangeAdd          <|> try pChangeDel          <|> try pChangeMod          <|> pChangeModDN -pChangeAdd :: CharParser st ChangeRecord+pChangeAdd :: CharParser st LDIFRecord pChangeAdd = do     dn <- pDNSpec     pSEP@@ -103,7 +103,7 @@     vals <- sepEndBy1 pAttrValSpec pSEP     return $ ChangeRecord dn (ChangeAdd vals) -pChangeDel :: CharParser st ChangeRecord+pChangeDel :: CharParser st LDIFRecord pChangeDel = do     dn <- pDNSpec     pSEP@@ -113,7 +113,7 @@     pSEP     return $ ChangeRecord dn ChangeDelete -pChangeMod :: CharParser st ChangeRecord+pChangeMod :: CharParser st LDIFRecord pChangeMod = do     dn <- pDNSpec     pSEP@@ -124,7 +124,7 @@     mods <- sepEndBy1 pModSpec (char '-' >> pSEP)     return $ ChangeRecord dn (ChangeModify mods) -pChangeModDN :: CharParser st ChangeRecord+pChangeModDN :: CharParser st LDIFRecord pChangeModDN = do     dn <- pDNSpec     pSEP@@ -158,6 +158,7 @@  pAttrEqValue :: CharParser st AttrValue pAttrEqValue = do+   pFILL    att <- pAttributeType    char '='    val <- pAttrValueDN@@ -185,7 +186,7 @@    vals <- sepEndBy pAttrValSpec pSEP    return $ mkMod modType att vals -mkMod :: String -> String -> [AttrValue] -> Modify+mkMod :: String -> Attribute -> [AttrValue] -> Modify mkMod modType att vals | modType == "add:" = ModAdd att (map (snd) vals)                        | modType == "delete:" = ModDelete att (map (snd) vals)                        | modType == "replace:" = ModReplace att (map (snd) vals)@@ -197,12 +198,12 @@        <|> try (string "delete:")        <|> string "replace:" -pAttributeDescription :: CharParser st String+pAttributeDescription :: CharParser st Attribute pAttributeDescription = pAttributeType -pAttributeType :: CharParser st String+pAttributeType :: CharParser st Attribute pAttributeType = try pLdapOid-             <|> (do { l <- letter; o <- pAttrTypeChars; return $ l:o } )+             <|> (do { l <- letter; o <- pAttrTypeChars; return (Attribute $ l:o) } )  pAttrValSpec :: CharParser st AttrValue pAttrValSpec = do@@ -230,11 +231,11 @@ pAttrTypeChars :: CharParser st String pAttrTypeChars = many (satisfy (\x -> isAlphaNum x || x == '-')) -pLdapOid :: CharParser st String+pLdapOid :: CharParser st Attribute pLdapOid = do    num <- many1 digit    rest <- many (do { string "."; n <- many1 digit; return $ '.':n})-   return $ num ++ concat rest+   return (Attribute $ num ++ concat rest)  pFILL :: CharParser st () pFILL = spaces

@@ -1,49 +1,45 @@ -- | LDIF serializers module Text.LDIF.Printer (-	ldif2Str,-        dn2Str,-	change2Str,-	content2Str+	ldif2str,+        dn2str,+	record2str ) where import Text.LDIF.Types import Data.List  -- | Serialize LDIF in LDIF Format-ldif2Str :: LDIF -> String-ldif2Str (LDIFContent v xs) = unlines $ (ver2Str v) ++ (map (content2Str) xs)-ldif2Str (LDIFChanges v xs) = unlines $ (ver2Str v) ++ (map (change2Str) xs)+ldif2str :: LDIF -> String+ldif2str (LDIFContent v xs) = unlines $ (ver2str v) ++ (map (record2str) xs)+ldif2str (LDIFChanges v xs) = unlines $ (ver2str v) ++ (map (record2str) xs)  -- | Serialize version to LDIF Format Lines-ver2Str :: Maybe String -> [String]-ver2Str Nothing = []-ver2Str (Just v) = ["version: "++v]+ver2str :: Maybe String -> [String]+ver2str Nothing = []+ver2str (Just v) = ["version: "++v]  -- | Serialize DN to LDIF Format-dn2Str :: DN -> String-dn2Str (DN xs) = intercalate "," $ map (\(n,v) -> n++"="++v) xs+dn2str :: DN -> String+dn2str (DN xs) = intercalate "," $ map (\((Attribute n),v) -> n++"="++v) xs  -- | Serialize Content Record in LDIF Format-content2Str :: ContentRecord -> String-content2Str (ContentRecord dn xs) = unlines $ [ "dn: "++(dn2Str dn) ] ++ (attrVals2Ln xs)---- | Serialize Change Record in LDIF Format-change2Str :: ChangeRecord -> String-change2Str (ChangeRecord dn (ChangeDelete))     = unlines   [ "dn: "++(dn2Str dn), "changetype: delete" ]-change2Str (ChangeRecord dn (ChangeAdd xs))     = unlines $ [ "dn: "++(dn2Str dn), "changetype: add"    ] ++ (attrVals2Ln xs)-change2Str (ChangeRecord dn (ChangeModify xs))  = unlines $ [ "dn: "++(dn2Str dn), "changetype: modify" ] ++ (mods2Ln xs)-change2Str (ChangeRecord dn (ChangeModDN))      = unlines $ [ "dn: "++(dn2Str dn), "changetype: moddn"  ]+record2str :: LDIFRecord -> String+record2str (ContentRecord dn xs)                = unlines $ [ "dn: "++(dn2str dn) ] ++ (attrVals2Ln xs)+record2str (ChangeRecord dn (ChangeDelete))     = unlines   [ "dn: "++(dn2str dn), "changetype: delete" ]+record2str (ChangeRecord dn (ChangeAdd xs))     = unlines $ [ "dn: "++(dn2str dn), "changetype: add"    ] ++ (attrVals2Ln xs)+record2str (ChangeRecord dn (ChangeModify xs))  = unlines $ [ "dn: "++(dn2str dn), "changetype: modify" ] ++ (mods2Ln xs)+record2str (ChangeRecord dn (ChangeModDN))      = unlines $ [ "dn: "++(dn2str dn), "changetype: moddn"  ]  attrVals2Ln :: [AttrValue] -> [String] attrVals2Ln xs = map (attrVal2Ln) xs  attrVal2Ln :: AttrValue -> String-attrVal2Ln (n,v) = n ++ ": "++v+attrVal2Ln ((Attribute n),v) = n ++ ": "++v  mods2Ln :: [Modify] -> [String] mods2Ln xs = intercalate ["-"] $ map (mod2Ln) xs  mod2Ln :: Modify -> [String]-mod2Ln (ModAdd     nm xs) = [ attrVal2Ln ("add",nm)     ] ++ (map (\v -> attrVal2Ln (nm,v)) xs) -mod2Ln (ModDelete  nm xs) = [ attrVal2Ln ("delete",nm)  ] ++ (map (\v -> attrVal2Ln (nm,v)) xs)-mod2Ln (ModReplace nm xs) = [ attrVal2Ln ("replace",nm) ] ++ (map (\v -> attrVal2Ln (nm,v)) xs)+mod2Ln (ModAdd     a@(Attribute nm) xs) = [ attrVal2Ln ((Attribute "add"),nm)     ] ++ (map (\v -> attrVal2Ln (a,v)) xs) +mod2Ln (ModDelete  a@(Attribute nm) xs) = [ attrVal2Ln ((Attribute "delete"),nm)  ] ++ (map (\v -> attrVal2Ln (a,v)) xs)+mod2Ln (ModReplace a@(Attribute nm) xs) = [ attrVal2Ln ((Attribute "replace"),nm) ] ++ (map (\v -> attrVal2Ln (a,v)) xs)

@@ -1,68 +0,0 @@--- | LDIF related operations-module Text.LDIF.Proc (-        findChangesByDN,-        findContentsByDN,-	findContentByDN,-	diffLDIF,-        diffRecord -)-where-import Text.LDIF.Types-import Data.Maybe---- | Find all Changes with given DN-findChangesByDN :: LDIF -> DN -> [ChangeRecord]-findChangesByDN _ _ = error "not implemented"---- | Find all Contents with given DN-findContentsByDN :: LDIF -> DN -> [ContentRecord]-findContentsByDN (LDIFContent _ entries) dn = filter (\x -> (coDN x) == dn) entries-findContentsByDN _ _ = []---- | Find first Content with given DN-findContentByDN :: LDIF -> DN -> Maybe ContentRecord-findContentByDN ldif dn = case findContentsByDN ldif dn of-                                 []   -> Nothing-                                 xs   -> Just (head xs)---- | Create Change LDIF between to LDIF contents. If any--- | of input argument is not LDIFContent it returns Nothing. --- | If there is not difference the Change LDIF with empty--- | change list is returned.--- |--- | Unsing following strategy: --- | 1. Iterate over L1 DN's and Modify / Remove Content --- | 2. Iterate over L2 and Add Content not in L1-diffLDIF :: LDIF -> LDIF -> Maybe LDIF-diffLDIF l1@(LDIFContent _ c1) l2@(LDIFContent v2 c2) = Just (LDIFChanges v2 (changes ++ adds))-   where -      adds = map (content2add) $ filter (not . isEntryIn l1) c2-      changes = filter (not . isDummyChangeRecord) $ foldl (processEntry) [] c1-      processEntry xs e1 = let me2 = findContentByDN l2 (coDN e1) -                               change = case me2 of-					   Nothing -> ChangeRecord (coDN e1) ChangeDelete-                                           Just e2 -> fromJust $ diffRecord e1 e2-                           in xs ++ [change]-      isEntryIn ll ex = let mex = findContentByDN ll (coDN ex)-                        in case mex of-                          Nothing -> False-                          Just _  -> True-      content2add (ContentRecord dn vals) = ChangeRecord dn (ChangeAdd vals)-diffLDIF _ _ = Nothing---- | Diff two AttrVal Records if any of provided. --- | Implementation uses inefficient algorithm for large count of attributes within ContentRecord.-diffRecord :: ContentRecord -> ContentRecord -> Maybe ChangeRecord-diffRecord r1 r2 | (coDN r1) /= (coDN r2) = Nothing-                 | otherwise = Just (ChangeRecord (coDN r1) (ChangeModify mods))-   where-      mods = delMods ++ addMods-      addMods = map (\x -> ModAdd (fst x) [(snd x)]) addVals-      delMods = map (\x -> ModDelete (fst x) [(snd x)]) delVals-      addVals = filter (\x -> not $ elem x (coAttrVals r1)) (coAttrVals r2) :: [AttrValue]-      delVals = filter (\x -> not $ elem x (coAttrVals r2)) (coAttrVals r1) :: [AttrValue]---- | Change record without any impact-isDummyChangeRecord :: ChangeRecord -> Bool-isDummyChangeRecord (ChangeRecord _ (ChangeModify [])) = True -isDummyChangeRecord _ = False

@@ -1,17 +1,24 @@ -- | LDIF related types module Text.LDIF.Types (  	LDIF(..),   -        ContentRecord(..),-        ChangeRecord(..),+        LDIFRecord(..),         Change(..),         Modify(..),          DN(..),          LDIFType(..),-        Attribute, Value, AttrValue+        Attribute(..), Value, AttrValue ) where+import Data.Char -type Attribute = String+newtype Attribute = Attribute String deriving Show++instance Eq Attribute where+    (Attribute xs) == (Attribute ys)  = (map toUpper xs) == (map toUpper ys)++instance Ord Attribute where+    (Attribute xs) `compare` (Attribute ys)  = (map toUpper xs) `compare` (map toUpper ys)+ type Value = String type AttrValue = (Attribute, Value) @@ -20,14 +27,13 @@  -- | Represents LDIF structure, it can be either simply LDIF data dump or -- | changes LDIF with LDAP operations -data LDIF = LDIFContent { lcVersion :: Maybe String, lcEntries :: [ContentRecord] }-          | LDIFChanges { lcVersion :: Maybe String, lcChanges :: [ChangeRecord] } deriving (Show, Eq)+data LDIF = LDIFContent { lcVersion :: Maybe String, lcEntries :: [LDIFRecord] }+          | LDIFChanges { lcVersion :: Maybe String, lcChanges :: [LDIFRecord] } deriving (Show, Eq)  -- | Represents one data record within LDIF file with DN and content-data ContentRecord =ContentRecord { coDN :: DN, coAttrVals :: [AttrValue] } deriving (Show, Eq)- -- | Represents one change record within LDIF file with DN and content-data ChangeRecord = ChangeRecord  { chDN :: DN, chOp :: Change } deriving (Show, Eq)+data LDIFRecord = ContentRecord { reDN :: DN, coAttrVals :: [AttrValue] } +                | ChangeRecord  { reDN :: DN, chOp :: Change } deriving (Show, Eq)  -- | Represents one LDAP operation within changes LDIF data Change = ChangeAdd     { chAttrVals :: [AttrValue] }@@ -42,5 +48,3 @@  -- | Represents Distinguished Name (DN) data DN = DN { dnAttrVals :: [AttrValue] } deriving (Show, Eq)--

@@ -0,0 +1,56 @@+-- | LDIF related operations+module Text.LDIF.Utils (+        findRecordsByDN,+	findRecordByDN,+        isDNPrefixOf,+        sizeOfDN,+        takeDNPrefix,+        leafOfDN,+        rootOfDN,+        isDummyRecord+)+where+import Text.LDIF.Types+import Text.LDIF.Printer+import Data.Maybe+import Data.Either+import Data.List (nub)++-- | Find all Contents with given DN+findRecordsByDN :: LDIF -> DN -> [LDIFRecord]+findRecordsByDN (LDIFContent _ entries) dn = filter (\x -> (reDN x) == dn) entries+findRecordsByDN (LDIFChanges _ entries) dn = filter (\x -> (reDN x) == dn) entries++-- | Find first Content with given DN+findRecordByDN :: LDIF -> DN -> Maybe LDIFRecord+findRecordByDN ldif dn = case findRecordsByDN ldif dn of+                                 []   -> Nothing+                                 xs   -> Just (head xs)+++-- | Change record without any impact+isDummyRecord :: LDIFRecord -> Bool+isDummyRecord (ChangeRecord _ (ChangeModify [])) = True +isDummyRecord _ = False++leafOfDN :: DN -> AttrValue+leafOfDN xs = getDNValue xs 0++rootOfDN :: DN -> AttrValue+rootOfDN xs = getDNValue xs ((sizeOfDN xs)-1)++sizeOfDN :: DN -> Int+sizeOfDN (DN vals) = length vals++getDNValue :: DN -> Int -> AttrValue+getDNValue (DN vals) idx = vals !! idx++takeDNPrefix :: DN -> Int -> DN+takeDNPrefix (DN vals) n = (DN (take n vals))++-- | Check if the dn1 is prefix of dn2+isDNPrefixOf :: DN -> DN -> Bool+isDNPrefixOf dn1 dn2 | (sizeOfDN dn1) >= (sizeOfDN dn2) = False+                     | otherwise = let n = (sizeOfDN dn2)+                                   in (takeDNPrefix dn1 n) == dn2+

@@ -12,5 +12,5 @@   ml1 <- parseLDIFFile (args !! 0)   ml2 <- parseLDIFFile (args !! 1)   case rights [ml1,ml2] of -       [l1,l2] -> putStrLn $ ldif2Str $ fromJust $ diffLDIF l1 l2  +       [l1,l2] -> putStrLn $ ldif2str $ fromJust $ diffLDIF l1 l2          _       -> print $ lefts [ml1,ml2] 

@@ -9,47 +9,45 @@ import qualified Data.Set as Set  ldif2html :: Set.Set String -> LDIF -> String-ldif2html idx (LDIFContent v xs) = unlines $ (ver2Str v) ++ (map (content2html idx) xs)-ldif2html idx (LDIFChanges v xs) = unlines $ (ver2Str v) ++ (map (change2html idx) xs)+ldif2html idx (LDIFContent v xs) = unlines $ (ver2str v) ++ (map (record2html idx) xs)+ldif2html idx (LDIFChanges v xs) = unlines $ (ver2str v) ++ (map (record2html idx) xs)  -- | Serialize version to LDIF Format Lines-ver2Str :: Maybe String -> [String]-ver2Str Nothing = []-ver2Str (Just v) = ["version: "++v]+ver2str :: Maybe String -> [String]+ver2str Nothing = []+ver2str (Just v) = ["version: "++v]  -- | Serialize DN to LDIF Format dn2html :: DN -> String-dn2html ys@(DN xs) = concat [ "<div id=\"abc"++nm++"\"></div><b>dn:</b> <font color=\"green\"><b>", intercalate "," $ map (\(n,v) -> n++"="++v) xs, "</b></font>"]+dn2html ys@(DN xs) = concat [ "<div id=\"abc"++nm++"\"></div><b>dn:</b> <font color=\"green\"><b>", dnstr, "</b></font>"]       where-         nm = dn2last ys+        dnstr = intercalate "," $ map (\((Attribute n),v) -> n++"="++v) xs+        nm = dn2last ys  dn2last (DN xs) = snd $ head xs --- | Serialize Content Record in LDIF Format-content2html :: Set.Set String -> ContentRecord -> String-content2html idx (ContentRecord dn xs) = unlines $ [ (dn2html dn) ] ++ (attrVals2Ln idx xs)- -- | Serialize Change Record in LDIF Format-change2html :: Set.Set String -> ChangeRecord -> String-change2html idx (ChangeRecord dn (ChangeDelete))     = unlines   [ (dn2Str dn), "changetype: delete" ]-change2html idx (ChangeRecord dn (ChangeAdd xs))    = unlines $ [ (dn2html dn), "changetype: add"    ] ++ (attrVals2Ln idx xs)-change2html idx (ChangeRecord dn (ChangeModify xs))  = unlines $ [ (dn2Str dn), "changetype: modify" ] ++ (mods2Ln idx xs)-change2html idx (ChangeRecord dn (ChangeModDN))      = unlines $ [ (dn2Str dn), "changetype: moddn"  ]+record2html :: Set.Set String -> LDIFRecord -> String+record2html idx (ChangeRecord dn (ChangeDelete))     = unlines   [ (dn2str dn), "changetype: delete" ]+record2html idx (ChangeRecord dn (ChangeAdd xs))    = unlines $ [ (dn2html dn), "changetype: add"    ] ++ (attrVals2Ln idx xs)+record2html idx (ChangeRecord dn (ChangeModify xs))  = unlines $ [ (dn2str dn), "changetype: modify" ] ++ (mods2Ln idx xs)+record2html idx (ChangeRecord dn (ChangeModDN))      = unlines $ [ (dn2str dn), "changetype: moddn"  ]+record2html idx (ContentRecord dn xs) = unlines $ [ (dn2html dn) ] ++ (attrVals2Ln idx xs)  attrVals2Ln :: Set.Set String -> [AttrValue] -> [String] attrVals2Ln idx xs = map (attrVal2Ln idx) xs  attrVal2Ln :: Set.Set String -> AttrValue -> String-attrVal2Ln idx (n,v) = if Set.member v idx then "<b>"++n++"</b> : <a href=\"#abc"++v++"\">"++v++"</a>"+attrVal2Ln idx ((Attribute n),v) = if Set.member v idx then "<b>"++n++"</b> : <a href=\"#abc"++v++"\">"++v++"</a>"                           else "<b>"++n++"</b> : "++v  mods2Ln :: Set.Set String -> [Modify] -> [String] mods2Ln idx xs = intercalate ["-"] $ map (mod2Ln idx) xs  mod2Ln :: Set.Set String -> Modify -> [String]-mod2Ln idx (ModAdd     nm xs) = [ attrVal2Ln idx ("add",nm)     ] ++ (map (\v -> attrVal2Ln idx (nm,v)) xs) -mod2Ln idx (ModDelete  nm xs) = [ attrVal2Ln idx ("delete",nm)  ] ++ (map (\v -> attrVal2Ln idx (nm,v)) xs)-mod2Ln idx (ModReplace nm xs) = [ attrVal2Ln idx ("replace",nm) ] ++ (map (\v -> attrVal2Ln idx (nm,v)) xs)+mod2Ln idx (ModAdd     a@(Attribute nm) xs) = [ attrVal2Ln idx ((Attribute "add"),nm)     ] ++ (map (\v -> attrVal2Ln idx (a,v)) xs) +mod2Ln idx (ModDelete  a@(Attribute nm) xs) = [ attrVal2Ln idx ((Attribute "delete"),nm)  ] ++ (map (\v -> attrVal2Ln idx (a,v)) xs)+mod2Ln idx (ModReplace a@(Attribute nm) xs) = [ attrVal2Ln idx ((Attribute "replace"),nm) ] ++ (map (\v -> attrVal2Ln idx (a,v)) xs)  -- Dummy ldif2html implementation but it should -- display LDIF file as HTML with values as href to@@ -75,5 +73,5 @@        xs  -> mapM_ print xs  dns :: LDIF -> Set.Set String-dns (LDIFContent _ xs) = Set.fromList $ nub $ map (dn2last . coDN) xs-dns (LDIFChanges _ xs) = Set.fromList $ nub $ map (dn2last . chDN) xs+dns (LDIFContent _ xs) = Set.fromList $ nub $ map (dn2last . reDN) xs+dns (LDIFChanges _ xs) = Set.fromList $ nub $ map (dn2last . reDN) xs

@@ -0,0 +1,39 @@+{-# LANGUAGE DeriveDataTypeable #-}+-- | Apply LDAP operations within LDIF on another LDIF.+-- | Without schema related verification like syntax, cardinality etc.+import Data.List+import Data.Either+import Data.Maybe+import Control.Monad +import System.FilePath +import System.Environment+import Text.LDIF+import System.Console.CmdArgs++data LdifModify = LdifModify { baseFile :: FilePath+                             , modFiles  :: [FilePath]+                             , outFile  :: FilePath } deriving (Show, Data, Typeable)++defaultCfg = mode $ LdifModify { baseFile = def &= typFile & flag "f" & text "Base LDIF File"+                               , modFiles = def &= args & typ "LDIF Files for applying"+                               , outFile = def &= typFile & flag "o" & text "Output LDIF File" }++verifyCfg :: LdifModify -> IO ()+verifyCfg (LdifModify bf mfx ouf) | length bf  == 0   = error "Missing Base LDIF File parameter (-f)"+                                  | length mfx == 0   = error "Missing LDIF Files for applying as arguments"+                                  | otherwise         = return ()                                                              ++main = do+  cfg <- cmdArgs "LDIF Modify. Apply LDAP operations from LDIF to LDIF" [defaultCfg]+  verifyCfg cfg+  baseLDIF <- safeParseLDIFFile (baseFile cfg)+  modLDIFs <- mapM (safeParseLDIFFile) (modFiles cfg)+  let outLDIF = foldr (flip applyLDIF) baseLDIF modLDIFs+  if length (outFile cfg) == 0 then do+      putStrLn (ldif2str outLDIF)+    else do+      writeFile (outFile cfg) (ldif2str outLDIF)+      putStrLn $ (outFile cfg) ++ " written."++safeParseLDIFFile :: FilePath -> IO LDIF+safeParseLDIFFile name = liftM (either (\e -> error $ "Can not parse: "++(show e)) (id)) (parseLDIFFile name)