diff --git a/TODO.org b/TODO.org --- a/TODO.org +++ b/TODO.org @@ -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: and than :, - need to be asserted that and 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 -f [-o ] -* 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: and than :, + need to be asserted that and 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 -o [ ... ] +* 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 diff --git a/ldif.cabal b/ldif.cabal --- a/ldif.cabal +++ b/ldif.cabal @@ -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 diff --git a/src/Text/LDIF.hs b/src/Text/LDIF.hs --- a/src/Text/LDIF.hs +++ b/src/Text/LDIF.hs @@ -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 diff --git a/src/Text/LDIF/Apply.hs b/src/Text/LDIF/Apply.hs new file mode 100644 --- /dev/null +++ b/src/Text/LDIF/Apply.hs @@ -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 diff --git a/src/Text/LDIF/Diff.hs b/src/Text/LDIF/Diff.hs new file mode 100644 --- /dev/null +++ b/src/Text/LDIF/Diff.hs @@ -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] diff --git a/src/Text/LDIF/Parser.hs b/src/Text/LDIF/Parser.hs --- a/src/Text/LDIF/Parser.hs +++ b/src/Text/LDIF/Parser.hs @@ -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 diff --git a/src/Text/LDIF/Printer.hs b/src/Text/LDIF/Printer.hs --- a/src/Text/LDIF/Printer.hs +++ b/src/Text/LDIF/Printer.hs @@ -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) diff --git a/src/Text/LDIF/Proc.hs b/src/Text/LDIF/Proc.hs deleted file mode 100644 --- a/src/Text/LDIF/Proc.hs +++ /dev/null @@ -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 diff --git a/src/Text/LDIF/Types.hs b/src/Text/LDIF/Types.hs --- a/src/Text/LDIF/Types.hs +++ b/src/Text/LDIF/Types.hs @@ -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) - - diff --git a/src/Text/LDIF/Utils.hs b/src/Text/LDIF/Utils.hs new file mode 100644 --- /dev/null +++ b/src/Text/LDIF/Utils.hs @@ -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 + diff --git a/src/diffLDIF.hs b/src/diffLDIF.hs --- a/src/diffLDIF.hs +++ b/src/diffLDIF.hs @@ -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] diff --git a/src/ldif2html.hs b/src/ldif2html.hs --- a/src/ldif2html.hs +++ b/src/ldif2html.hs @@ -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 [ "
dn: ", intercalate "," $ map (\(n,v) -> n++"="++v) xs, ""] +dn2html ys@(DN xs) = concat [ "
dn: ", dnstr, ""] 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 ""++n++" : "++v++"" +attrVal2Ln idx ((Attribute n),v) = if Set.member v idx then ""++n++" : "++v++"" else ""++n++" : "++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 diff --git a/src/ldifmodify.hs b/src/ldifmodify.hs new file mode 100644 --- /dev/null +++ b/src/ldifmodify.hs @@ -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)