diff --git a/README.markdown b/README.markdown index 4970e1a..dded339 100644 --- a/README.markdown +++ b/README.markdown @@ -10,19 +10,22 @@ This library implements (the parts of) [RFC 4511][rfc4511] Bind Operation | 4.2 | ✔ Unbind Operation | 4.3 | ✔ Notice of Disconnection | 4.4.1 | ✘ -Search Operation | 4.5 | ✔† +Search Operation | 4.5 | ✔\* Modify Operation | 4.6 | ✔ Add Operation | 4.7 | ✔ Delete Operation | 4.8 | ✔ Modify DN Operation | 4.9 | ✘ Compare Operation | 4.10 | ✔ Abandon Operation | 4.11 | ✘ -Extended Operation | 4.12 | ✘ +Extended Operation | 4.12 | ✔ IntermediateResponse Message | 4.13 | ✘ -StartTLS Operation | 4.14 | ✘ +StartTLS Operation | 4.14 | ✔† LDAP over TLS | - | ✔ -†: approximate and extensible matches are untested, so probably do not work +\*: approximate and extensible matches are untested, so probably do not work +†: only serves as an example of Extended Operation, meaning that it does not change +connection's state on success, so it's useless for all practical purposes. +In other words, use LDAP over TLS instead. ``` % git grep '\bString\b' | wc -l diff --git a/src/Ldap/Asn1/FromAsn1.hs b/src/Ldap/Asn1/FromAsn1.hs index 6dd33a1..34755fd 100644 --- a/src/Ldap/Asn1/FromAsn1.hs +++ b/src/Ldap/Asn1/FromAsn1.hs @@ -62,6 +62,14 @@ instance FromAsn1 LdapString where Right t -> return (LdapString t) Left _ -> empty +{- | +LDAPOID ::= OCTET STRING -- Constrained to +-} +instance FromAsn1 LdapOid where + fromAsn1 = do + Asn1.OctetString s <- next + return (LdapOid s) + {- | LDAPDN ::= LDAPString -} @@ -250,6 +258,17 @@ instance FromAsn1 ProtocolServerOp where , fmap AddResponse (app 9) , fmap DeleteResponse (app 11) , fmap CompareResponse (app 15) + , do + Asn1.Start (Asn1.Container Asn1.Application 24) <- next + res <- fromAsn1 + name <- optional $ do + Asn1.Other Asn1.Context 0 s <- next + return s + value <- optional $ do + Asn1.Other Asn1.Context 1 s <- next + return s + Asn1.End (Asn1.Container Asn1.Application 24) <- next + return (ExtendedResponse res (fmap LdapOid name) value) ] where app l = do diff --git a/src/Ldap/Asn1/ToAsn1.hs b/src/Ldap/Asn1/ToAsn1.hs index 12cc53b..0e6b41b 100644 --- a/src/Ldap/Asn1/ToAsn1.hs +++ b/src/Ldap/Asn1/ToAsn1.hs @@ -175,6 +175,11 @@ DelRequest ::= [APPLICATION 10] LDAPDN CompareRequest ::= [APPLICATION 14] SEQUENCE { entry LDAPDN, ava AttributeValueAssertion } + +ExtendedRequest ::= [APPLICATION 23] SEQUENCE { + requestName [0] LDAPOID, + requestValue [1] OCTET STRING OPTIONAL } + -} instance ToAsn1 ProtocolClientOp where toAsn1 (BindRequest v n a) = @@ -216,6 +221,11 @@ instance ToAsn1 ProtocolClientOp where other Asn1.Application 10 (Text.encodeUtf8 dn) toAsn1 (CompareRequest dn av) = application 14 (toAsn1 dn <> sequence (toAsn1 av)) + toAsn1 (ExtendedRequest (LdapOid oid) mv) = + application 23 (fold + [ other Asn1.Context 0 oid + , maybe mempty (other Asn1.Context 1) mv + ]) {- | AuthenticationChoice ::= CHOICE { diff --git a/src/Ldap/Asn1/Type.hs b/src/Ldap/Asn1/Type.hs index 6c065f8..9fe6773 100644 --- a/src/Ldap/Asn1/Type.hs +++ b/src/Ldap/Asn1/Type.hs @@ -23,6 +23,7 @@ data ProtocolClientOp = | DeleteRequest LdapDn | CompareRequest LdapDn AttributeValueAssertion | ModifyRequest LdapDn [(Operation, PartialAttribute)] + | ExtendedRequest LdapOid (Maybe ByteString) deriving (Show, Eq, Ord) data ProtocolServerOp = @@ -34,6 +35,7 @@ data ProtocolServerOp = | AddResponse LdapResult | DeleteResponse LdapResult | CompareResponse LdapResult + | ExtendedResponse LdapResult (Maybe LdapOid) (Maybe ByteString) deriving (Show, Eq, Ord) data AuthenticationChoice = Simple ByteString diff --git a/src/Ldap/Client.hs b/src/Ldap/Client.hs index 0f28cde..1634b84 100644 --- a/src/Ldap/Client.hs +++ b/src/Ldap/Client.hs @@ -36,6 +36,9 @@ module Ldap.Client , delete -- * Compare Operation , compare + -- * Extended Operation + , Oid(..) + , extended -- * Waiting for Operation Completion , wait , waitSTM @@ -82,6 +85,7 @@ import Ldap.Client.Modify (Operation(..), modify) import Ldap.Client.Add (add) import Ldap.Client.Delete (delete) import Ldap.Client.Compare (compare) +import Ldap.Client.Extended (extended) newLdap :: IO Ldap @@ -199,4 +203,7 @@ dispatch Ldap { client } inq outq = Type.CompareResponse {} -> do traverse_ (\var -> putTMVar var (op :| [])) (Map.lookup mid results) return (Map.delete mid got, Map.delete mid results, counter) + Type.ExtendedResponse {} -> do + traverse_ (\var -> putTMVar var (op :| [])) (Map.lookup mid results) + return (Map.delete mid got, Map.delete mid results, counter) ]) diff --git a/src/Ldap/Client/Extended.hs b/src/Ldap/Client/Extended.hs new file mode 100644 index 0000000..a7e0d06 --- /dev/null +++ b/src/Ldap/Client/Extended.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE OverloadedStrings #-} +module Ldap.Client.Extended + ( extended + , extendedEither + , extendedAsync + , extendedAsyncSTM + , startTls + , startTlsEither + , startTlsAsync + , startTlsAsyncSTM + ) where + +import Control.Monad ((<=<)) +import Control.Monad.STM (STM, atomically) +import Data.ByteString (ByteString) +import Data.List.NonEmpty (NonEmpty((:|))) + +import qualified Ldap.Asn1.Type as Type +import Ldap.Client.Internal + + +extended :: Ldap -> Oid -> Maybe ByteString -> IO () +extended l oid mv = + raise =<< extendedEither l oid mv + +extendedEither :: Ldap -> Oid -> Maybe ByteString -> IO (Either ResponseError ()) +extendedEither l oid mv = + wait =<< extendedAsync l oid mv + +extendedAsync :: Ldap -> Oid -> Maybe ByteString -> IO (Async ()) +extendedAsync l oid mv = + atomically (extendedAsyncSTM l oid mv) + +extendedAsyncSTM :: Ldap -> Oid -> Maybe ByteString -> STM (Async ()) +extendedAsyncSTM l oid mv = + let req = extendedRequest oid mv in sendRequest l (extendedResult req) req + +extendedRequest :: Oid -> Maybe ByteString -> Request +extendedRequest (Oid oid) mv = + Type.ExtendedRequest (Type.LdapOid oid) mv + +extendedResult :: Request -> Response -> Either ResponseError () +extendedResult req (Type.ExtendedResponse (Type.LdapResult code (Type.LdapDn (Type.LdapString dn)) + (Type.LdapString msg) _) _ _ :| []) + | Type.Success <- code = Right () + | otherwise = Left (ResponseErrorCode req code (Dn dn) msg) +extendedResult req res = Left (ResponseInvalid req res) + + +startTls :: Ldap -> IO () +startTls = + raise <=< startTlsEither + +startTlsEither :: Ldap -> IO (Either ResponseError ()) +startTlsEither = + wait <=< startTlsAsync + +startTlsAsync :: Ldap -> IO (Async ()) +startTlsAsync = + atomically . startTlsAsyncSTM + +startTlsAsyncSTM :: Ldap -> STM (Async ()) +startTlsAsyncSTM l = + extendedAsyncSTM l (Oid "1.3.6.1.4.1.1466.20037") Nothing diff --git a/src/Ldap/Client/Internal.hs b/src/Ldap/Client/Internal.hs index 59f7eb1..6a0a821 100644 --- a/src/Ldap/Client/Internal.hs +++ b/src/Ldap/Client/Internal.hs @@ -8,6 +8,7 @@ module Ldap.Client.Internal , ClientMessage(..) , Type.ResultCode(..) , Async + , Oid(..) , AttrList -- * Waiting for Request Completion , wait @@ -59,6 +60,10 @@ instance Functor Async where newtype Dn = Dn Text deriving (Show, Eq) + +newtype Oid = Oid ByteString + deriving (Show, Eq) + newtype Password = Password ByteString deriving (Show, Eq) diff --git a/test/Ldap/Client/ExtendedSpec.hs b/test/Ldap/Client/ExtendedSpec.hs new file mode 100644 index 0000000..6322be7 --- /dev/null +++ b/test/Ldap/Client/ExtendedSpec.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE OverloadedStrings #-} +module Ldap.Client.ExtendedSpec (spec) where + +import Test.Hspec + +import Ldap.Client as Ldap +import Ldap.Client.Extended as Ldap +import qualified Ldap.Asn1.Type as Ldap.Type + +import SpecHelper (locally ) + + +spec :: Spec +spec = do + it "sends an extended request" $ do + res <- locally $ \l -> + Ldap.extended l (Oid "0") Nothing + res `shouldBe` Left + (ResponseError (ResponseErrorCode (Ldap.Type.ExtendedRequest (Ldap.Type.LdapOid "0") Nothing) + ProtocolError + (Dn "") + "0 not supported")) + + it "sends a startTLS request" $ do + res <- locally $ \l -> + Ldap.startTls l + res `shouldBe` Left + (ResponseError (ResponseErrorCode (Ldap.Type.ExtendedRequest (Ldap.Type.LdapOid "1.3.6.1.4.1.1466.20037") + Nothing) + ProtocolError + (Dn "") + "1.3.6.1.4.1.1466.20037 not supported")) diff --git a/test/ldap.js b/test/ldap.js index f555737..7752293 100755 --- a/test/ldap.js +++ b/test/ldap.js @@ -89,50 +89,6 @@ server.search('o=localhost', [authorize], function(req, res, next) { return next(); }); -server.add('o=localhost', [], function(req, res, next) { - var attributes = req.toObject().attributes; - pokemon.push(req.toObject()) - res.end(); - return next(); -}); - -server.del('o=localhost', [], function(req, res, next) { - for (var i = 0; i < pokemon.length; i++) { - if (req.dn.toString() === pokemon[i].dn) { - pokemon.splice(i, 1); - res.end(); - return next(); - } - } - - return next(new ldapjs.NoSuchObjectError(req.dn.toString())); -}); - -server.compare('o=localhost', [], function(req, res, next) { - for (var i = 0; i < pokemon.length; i++) { - if (req.dn.toString() === pokemon[i].dn) { - for (var attribute in pokemon[i].attributes) { - if (attribute === req.attribute) { - for (var j = 0; j < pokemon[i].attributes[attribute].length; j++) { - if (pokemon[i].attributes[attribute][j] === req.value) { - res.end(true); - return next(); - } - } - - res.end(false); - return next(); - } - } - - res.end(false); - return next(); - } - } - - return next(new ldapjs.NoSuchObjectError(req.dn.toString())); -}); - // Javascript is helpless Array.prototype.diff = function(arr) { return this.filter(function(idx) { return arr.indexOf(idx) < 0; }); @@ -183,6 +139,50 @@ server.modify('o=localhost', [], function(req, res, next) { return next(new ldapjs.NoSuchObjectError(dn)); }); +server.add('o=localhost', [], function(req, res, next) { + var attributes = req.toObject().attributes; + pokemon.push(req.toObject()) + res.end(); + return next(); +}); + +server.del('o=localhost', [], function(req, res, next) { + for (var i = 0; i < pokemon.length; i++) { + if (req.dn.toString() === pokemon[i].dn) { + pokemon.splice(i, 1); + res.end(); + return next(); + } + } + + return next(new ldapjs.NoSuchObjectError(req.dn.toString())); +}); + +server.compare('o=localhost', [], function(req, res, next) { + for (var i = 0; i < pokemon.length; i++) { + if (req.dn.toString() === pokemon[i].dn) { + for (var attribute in pokemon[i].attributes) { + if (attribute === req.attribute) { + for (var j = 0; j < pokemon[i].attributes[attribute].length; j++) { + if (pokemon[i].attributes[attribute][j] === req.value) { + res.end(true); + return next(); + } + } + + res.end(false); + return next(); + } + } + + res.end(false); + return next(); + } + } + + return next(new ldapjs.NoSuchObjectError(req.dn.toString())); +}); + server.listen(port, function() { console.log("ldaps://localhost:%d", port); });