From aa4f17b354a1ed8216ab4996e33a151fe6d90538 Mon Sep 17 00:00:00 2001 From: Matvey Aksenov Date: Tue, 31 Mar 2015 21:44:18 +0000 Subject: [PATCH] Mock LDAP server for testing --- .gitignore | 1 + README.markdown | 11 ++- ldap-client.cabal | 3 +- src/Ldap/Client.hs | 1 + test/Ldap/ClientSpec.hs | 159 ++++++++++++++++++---------------------- test/Main.hs | 20 +++++ test/Spec.hs | 2 +- test/SpecHelper.hs | 4 + test/ldap.js | 90 +++++++++++++++++++++++ 9 files changed, 201 insertions(+), 90 deletions(-) create mode 100644 test/Main.hs create mode 100644 test/SpecHelper.hs create mode 100755 test/ldap.js diff --git a/.gitignore b/.gitignore index 80aa10a..392cc50 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ dist/ .cabal-sandbox/ cabal.sandbox.config +node_modules diff --git a/README.markdown b/README.markdown index e707f6d..3a98281 100644 --- a/README.markdown +++ b/README.markdown @@ -1,5 +1,5 @@ ldap-client ------------ +=========== **NOTE: This is work in progress. Don't use it! If you really need LDAP integration, check out [LDAP][LDAP]** @@ -25,6 +25,15 @@ LDAP over TLS | - | ✔ ``` % git grep '\bString\b' | wc -l 2 +``` + +Testing +------- + +```shell +% sudo apt-get install npm +% npm install ldapjs +% cabal test ``` [rfc4511]: https://tools.ietf.org/html/rfc4511 diff --git a/ldap-client.cabal b/ldap-client.cabal index e90acf5..ebc80a7 100644 --- a/ldap-client.cabal +++ b/ldap-client.cabal @@ -50,10 +50,11 @@ test-suite spec hs-source-dirs: test main-is: - Spec.hs + Main.hs other-modules: Ldap.ClientSpec build-depends: base >= 4.7 && < 5 , hspec , ldap-client + , process diff --git a/src/Ldap/Client.hs b/src/Ldap/Client.hs index e4d3ac8..39be663 100644 --- a/src/Ldap/Client.hs +++ b/src/Ldap/Client.hs @@ -21,6 +21,7 @@ module Ldap.Client , Type.Scope(..) , Attr(..) , SearchEntry(..) + , SearchError(..) , search , searchEither , searchAsync diff --git a/test/Ldap/ClientSpec.hs b/test/Ldap/ClientSpec.hs index 2c25985..2c0cd68 100644 --- a/test/Ldap/ClientSpec.hs +++ b/test/Ldap/ClientSpec.hs @@ -5,108 +5,93 @@ module Ldap.ClientSpec (spec) where import Data.Monoid ((<>)) import Test.Hspec -import Ldap.Client (Host(..), Dn(..), Password(..), Filter(..), Scope(..), scope, size, Attr(..), BindError(..), ResultCode(..)) +import Ldap.Client (Dn(..), Password(..), Filter(..), Scope(..), Attr(..)) import qualified Ldap.Client as Ldap +import SpecHelper (port) + spec :: Spec spec = do + let locally = Ldap.with localhost port + search l f = Ldap.search l (Dn "o=localhost") (Ldap.scope WholeSubtree <> Ldap.typesOnly True) f [] - context "public LDAP server at MIT\ - \" $ do + context "bind" $ do + it "can bind" $ do + res <- locally $ \l -> do + Ldap.bind l (Dn "cn=admin") (Password "secret") + res `shouldBe` Right () - it "searches the whole tree for the entries that have ‘uid’ attribute" $ do - Right () <- Ldap.with mit 389 $ \l -> do - res <- Ldap.search l (Dn "ou=People,dc=scripts,dc=mit,dc=edu") - (scope WholeSubtree) - (Present (Attr "uid")) - [] - res `shouldSatisfy` (not . null) - return () + it "can try to bind with a wrong password" $ do + res <- locally $ \l -> do + Ldap.bind l (Dn "cn=admin") (Password "public") + res `shouldBe` Left (Ldap.BindError (Ldap.BindErrorCode Ldap.InvalidCredentials)) - it "searches the single level for the first 10 entries that have ‘uid’ attribute" $ do - Right () <- Ldap.with mit 389 $ \l -> do - res <- Ldap.search l (Dn "ou=People,dc=scripts,dc=mit,dc=edu") - (scope SingleLevel <> size 10) - (Present (Attr "uid")) - [] - length res `shouldBe` 10 - return () + it "can login as another user" $ do + res <- locally $ \l -> do + Ldap.bind l (Dn "cn=admin") (Password "secret") + Ldap.SearchEntry udn _ : [] + <- search l (Attr "cn" := "pikachu") + Ldap.bind l udn (Password "i-choose-you") + res `shouldBe` Right () - it "searches the single level for the first 10 entries that do not have ‘uid’ attribute" $ do - Right () <- Ldap.with mit 389 $ \l -> do - res <- Ldap.search l (Dn "ou=People,dc=scripts,dc=mit,dc=edu") - (scope SingleLevel <> size 10) - (Not (Present (Attr "uid"))) - [] - res `shouldBe` [] - return () + context "search" $ do + it "cannot search as ‘pikachu’" $ do + res <- locally $ \l -> do + Ldap.bind l (Dn "cn=pikachu,o=localhost") (Password "i-choose-you") + search l (Present (Attr "password")) + res `shouldBe` Left (Ldap.SearchError (Ldap.SearchErrorCode Ldap.InsufficientAccessRights)) - context "online LDAP test server \ - \" $ do + it "can use ‘present’ filter" $ do + res <- locally $ \l -> do + res <- search l (Present (Attr "password")) + dns res `shouldBe` [Dn "cn=pikachu,o=localhost"] + res `shouldBe` Right () - context "bind" $ do - it "can bind" $ do - Right () <- Ldap.with forumsys 389 $ \l -> do - Ldap.bind l (Dn "cn=read-only-admin,dc=example,dc=com") - (Password "password") - return () + it "can use ‘equality match’ filter" $ do + res <- locally $ \l -> do + res <- search l (Attr "type" := "flying") + dns res `shouldMatchList` [Dn "cn=butterfree,o=localhost", Dn "cn=charizard,o=localhost"] + res `shouldBe` Right () - it "can try to bind with a wrong password" $ do - Right () <- Ldap.with forumsys 389 $ \l -> do - res <- Ldap.bindEither l (Dn "cn=read-only-admin,dc=example,dc=com") - (Password "drowssap") - res `shouldBe` Left (BindErrorCode InvalidCredentials) - return () + it "can use ‘and’ filter" $ do + res <- locally $ \l -> do + res <- search l (And [ Attr "type" := "fire" + , Attr "evolution" := "1" + ]) + dns res `shouldBe` [Dn "cn=charmeleon,o=localhost"] + res `shouldBe` Right () - it "can login as another user" $ do - Right () <- Ldap.with forumsys 389 $ \l -> do - Ldap.bind l (Dn "cn=read-only-admin,dc=example,dc=com") - (Password "password") - Ldap.SearchEntry udn _ : _ - <- Ldap.search l (Dn "dc=example,dc=com") - (Ldap.scope WholeSubtree <> Ldap.typesOnly True) - (Attr "uid" := "euler") - [] - Ldap.bind l udn (Password "password") - return () + it "can use ‘or’ filter" $ do + res <- locally $ \l -> do + res <- search l (Or [ Attr "type" := "fire" + , Attr "evolution" := "1" + ]) + dns res `shouldMatchList` + [ Dn "cn=charizard,o=localhost" + , Dn "cn=charmeleon,o=localhost" + , Dn "cn=charmander,o=localhost" + , Dn "cn=metapod,o=localhost" + , Dn "cn=wartortle,o=localhost" + , Dn "cn=ivysaur,o=localhost" + ] + res `shouldBe` Right () - context "search" $ do - let search l f = Ldap.search l (Dn "dc=example,dc=com") (Ldap.scope WholeSubtree <> Ldap.typesOnly True) f [] + it "can use ‘or’ filter" $ do + res <- locally $ \l -> do + res <- search l (Not (Or [ Attr "type" := "fire" + , Attr "evolution" :>= "1" + ])) + dns res `shouldMatchList` + [ Dn "cn=bulbasaur,o=localhost" + , Dn "cn=squirtle,o=localhost" + , Dn "cn=caterpie,o=localhost" + , Dn "cn=pikachu,o=localhost" + ] + res `shouldBe` Right () - it "can use ‘present’ filter" $ do - Right () <- Ldap.with forumsys 389 $ \l -> do - res <- search l (Present (Attr "initials")) - dns res `shouldMatchList` [Dn "uid=test,dc=example,dc=com"] - return () - - it "can use ‘equality match’ filter" $ do - Right () <- Ldap.with forumsys 389 $ \l -> do - res <- search l (Attr "sn" := "Tesla") - dns res `shouldMatchList` [Dn "uid=tesla,dc=example,dc=com"] - return () - - it "can use ‘or’ filter" $ do - Right () <- Ldap.with forumsys 389 $ \l -> do - res <- search l (Or [ Attr "sn" := "Tesla" - , Attr "cn" := "Issac Newton" -- why the fuck "Issac"? - ]) - dns res `shouldMatchList` [Dn "uid=tesla,dc=example,dc=com", Dn "uid=newton,dc=example,dc=com"] - return () - - it "can use ‘and’ and ‘not’ filters" $ do - Right () <- Ldap.with forumsys 389 $ \l -> do - res <- search l (And [ Attr "uniqueMember" := "uid=tesla,dc=example,dc=com" - , Not (Attr "uniqueMember" := "uid=einstein,dc=example,dc=com") - ]) - dns res `shouldMatchList` [Dn "ou=italians,ou=scientists,dc=example,dc=com"] - return () - -mit :: Host -mit = Plain "scripts.mit.edu" - -forumsys :: Host -forumsys = Plain "ldap.forumsys.com" +localhost :: Ldap.Host +localhost = Ldap.Plain "localhost" dns :: [Ldap.SearchEntry] -> [Dn] dns (Ldap.SearchEntry dn _ : es) = dn : dns es diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 index 0000000..73b6ad6 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,20 @@ +module Main (main) where + +import Control.Concurrent (threadDelay) +import Control.Exception (bracket) +import System.IO (hGetLine) +import System.Process (runInteractiveProcess, terminateProcess, waitForProcess) +import Test.Hspec + +import qualified Spec +import SpecHelper (port) + + +main :: IO () +main = + bracket (do (_, out, _, h) <- runInteractiveProcess "./test/ldap.js" [] Nothing (Just [("PORT", show port)]) + hGetLine out + return h) + (\h -> do terminateProcess h + waitForProcess h) + (\_ -> hspec Spec.spec) diff --git a/test/Spec.hs b/test/Spec.hs index a824f8c..5416ef6 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1 +1 @@ -{-# OPTIONS_GHC -F -pgmF hspec-discover #-} +{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-} diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs new file mode 100644 index 0000000..5c061ba --- /dev/null +++ b/test/SpecHelper.hs @@ -0,0 +1,4 @@ +module SpecHelper (port) where + +port :: Num a => a +port = 24620 diff --git a/test/ldap.js b/test/ldap.js new file mode 100755 index 0000000..69925af --- /dev/null +++ b/test/ldap.js @@ -0,0 +1,90 @@ +#!/usr/bin/env nodejs + +var ldapjs = require('ldapjs'); +var server = ldapjs.createServer(); +var port = process.env.PORT + +// +var pokemon = [ + { dn: 'cn=bulbasaur,o=localhost', + attributes: { cn: 'bulbasaur', evolution: "0", type: ["grass", "poison"], } + }, + { dn: 'cn=ivysaur,o=localhost', + attributes: { cn: 'ivysaur', evolution: "1", type: ["grass", "poison"], } + }, + { dn: 'cn=venusaur,o=localhost', + attributes: { cn: 'venusaur', evolution: "2", type: ["grass", "poison"], } + }, + { dn: 'cn=charmander,o=localhost', + attributes: { cn: 'charmander', evolution: "0", type: ["fire"], } + }, + { dn: 'cn=charmeleon,o=localhost', + attributes: { cn: 'charmeleon', evolution: "1", type: ["fire"], } + }, + { dn: 'cn=charizard,o=localhost', + attributes: { cn: 'charizard', evolution: "2", type: ["fire", "flying"], } + }, + { dn: 'cn=squirtle,o=localhost', + attributes: { cn: 'squirtle', evolution: "0", type: ["water"], } + }, + { dn: 'cn=wartortle,o=localhost', + attributes: { cn: 'wartortle', evolution: "1", type: ["water"], } + }, + { dn: 'cn=blastoise,o=localhost', + attributes: { cn: 'blastoise', evolution: "2", type: ["water"], } + }, + { dn: 'cn=caterpie,o=localhost', + attributes: { cn: 'caterpie', evolution: "0", type: ["bug"], } + }, + { dn: 'cn=metapod,o=localhost', + attributes: { cn: 'metapod', evolution: "1", type: ["bug"], } + }, + { dn: 'cn=butterfree,o=localhost', + attributes: { cn: 'butterfree', evolution: "2", type: ["bug", "flying"], } + }, + { dn: 'cn=pikachu,o=localhost', + attributes: { cn: 'pikachu', evolution: "0", type: ["electic"], password: "i-choose-you" } + }, + ]; + +server.bind('cn=admin', function(req, res, next) { + if ((req.dn.toString() === 'cn=admin') && (req.credentials === 'secret')) { + res.end(); + return next(); + } else { + return next(new ldapjs.InvalidCredentialsError()); + } +}); + +server.bind('cn=pikachu,o=localhost', function(req, res, next) { + if ((req.dn.toString() === 'cn=pikachu,o=localhost') && (req.credentials === 'i-choose-you')) { + res.end(); + return next(); + } else { + return next(new ldapjs.InvalidCredentialsError()); + } +}); + +function authorize(req, res, next) { + var bindDN = req.connection.ldap.bindDN; + if ((bindDN.equals('cn=admin')) || + (bindDN.equals('cn=anonymous'))) { + return next(); + } else { + return next(new ldapjs.InsufficientAccessRightsError()); + } +} + +server.search('o=localhost', [authorize], function(req, res, next) { + for (var i = 0; i < pokemon.length; i++) { + if (req.filter.matches(pokemon[i].attributes)) + res.send(pokemon[i]); + }; + + res.end(); + return next(); +}); + +server.listen(port, function() { + console.log("ldap://localhost:%d", port); +});