QA@IT

VB.NETでローカルのOpenLDAPにアクセスできない

10842 PV

こんにちは、ASP.NET(VB.NET)で
LDAPサーバに連携して認証を行おうとしています。
LDAPははじめて触ります。

(LDAPサーバに格納されているアカウントとパスワードを
文字列として渡し、合致すればログインでき、合致しなければダイアログを
表示する仕様です)

最終的にはNECのEDSになる予定ですが、環境がないので
OpenLDAPでやっています。

今のところWindows 7上でローカル上に
インストール不要のOpenLDAPをC:\直下に展開し
(おそらく下記のものです)
http://sourceforge.jp/projects/openldapwin32/downloads/39746/OpenLDAP_2.4.9_without-openssl_win32.zip/

下記のようなDOSコマンドで実行しています。

set PATH=%PATH%;\OpenLDAP\local\bin
\OpenLDAP\local\libexec\slapd.exe -f \OpenLDAP\local\libexec\slapd.conf

特にslapd.confはデフォルトから変えていません。
以下のようなユーザを数人登録しています。

LDAP情報 初期設定============================
 database bdb
 suffix "dc=my-domain,dc=com"
 rootdn "cn=Manager,dc=my-domain,dc=com"
 rootpw secret

属性のエントリー
 DOS>ldapadd -x -D cn=Manager,dc=my-domain,dc=com -w secret -f add-testNN.ldif
 
 属性エントリーファイル(例:add-test01.ldif)
 dn: uid=test01,ou=Users,dc=my-domain,dc=com
 objectClass: top
 objectClass: person
 objectClass: organizationalPerson
 objectClass: inetOrgPerson
 uid: test01
 cn: test01
 sn: test01
 departmentNumber: 001
 employeeNumber: 01
 telephoneNumber: 03-1234-5678
 description: none
 mail: test01@demo.com
 userPassword: test01

以下のようなプログラムを実行しても、FindAllで"サーバーが利用できる状態にありません"の例外が発生してしまいます。
・SoftErra LDAP Browserはアクセスができています。
・VBA(Excelマクロ)でGetObjectを使えばユーザ一覧を取得できています。もしかするとDirectorySearcherを使わないほうがよいのでしょうか。
なにが悪いのでしょうか・・・

Imports System.DirectoryServices

Public Class frmLogin

Private Sub frmLogin_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
    Dim ht As New Hashtable
    ht = GetAllUsers()
    For i As Integer = 0 To ht.Count

    Next i

End Sub


'Reference: Accessing LDAP User list using VB.NET
'http://www.codeproject.com/Articles/8488/Accessing-LDAP-User-list-using-VB-NET

Public Function GetAllUsers() As Hashtable


    Dim strPath As String = "LDAP://IP:389/ou=Users,dc=my-domain,dc=com"
    Dim strUser As String = "cn=Manager,dc=my-domain,dc=com"
    Dim strPass As String = "secret"

    Dim oRoot As DirectoryEntry = New DirectoryEntry(strPath, strUser, strPass)

    Dim oSearcher As DirectorySearcher = New DirectorySearcher(oRoot)
    Dim oResults As SearchResultCollection
    Dim oResult As SearchResult
    Dim RetArray As New Hashtable()

    Try

        oSearcher.PropertiesToLoad.Add("uid")

        oResults = oSearcher.FindAll

       For Each oResult In oResults

            If Not oResult.GetDirectoryEntry().Properties("cn").Value = "" Then
                RetArray.Add(oResult.GetDirectoryEntry().Properties("uid").Value, _
                  oResult.GetDirectoryEntry().Properties("cn").Value)
            End If

        Next

    Catch e As Exception

        'MsgBox("Error is " & e.Message)
        Return RetArray

    End Try

    Return RetArray

End Function

End Class

"サーバーは使用可能ではありません。"
StackTrace " 場所 System.DirectoryServices.DirectoryEntry.Bind(Boolean throwIfFail)
場所 System.DirectoryServices.DirectoryEntry.Bind()
場所 System.DirectoryServices.DirectoryEntry.get_AdsObject()
場所 System.DirectoryServices.DirectorySearcher.FindAll(Boolean findMoreThanOne)
場所 System.DirectoryServices.DirectorySearcher.FindAll()
場所 LDAPAccess.frmLogin.GetAllUsers() 場所 C:\Users\user\Documents\Visual Studio 2010\Projects\LDAPAccess\LDAPAccess\Form1.vb:行 52" String

回答

当方、VB.NET 2008+OpenLDAP2.3でLDAP認証を実装したことがあります。
IDとPasswordを引数に渡して認証を行なう関数を書いてみます。
※実際の環境とは異なるので、サーバのIPアドレスなどは意図的に変えています。

ID、Passwordでの認証を達成したいのならばこれで十分ではないでしょうか。
あと、LDAPサーバの管理者のuidとパスワードをコードに記述しないで済むという
メリットがあります。

''' <summary>
''' ID、パスワードを元に認証を行ないます。
''' 認証成功時、TRUEを返します。
''' 認証失敗時、FALSEを返します。
''' </summary>
''' <param name="ID"></param>
''' <param name="passWord"></param>
''' <remarks>OpenLDAPに接続し、認証を実行します。</remarks>

Public Function Auth(ByVal ID As String, ByVal passWord As String) As Boolean
    Dim sDC As String = "ou=Users,dc=my-domain,dc=com"
    Dim adPath As String = "LDAP://127.0.0.1/" & sDC
    Dim sDN As String = "uid=" & ID & "," & sDC
    'uid=test01,ou=Users,dc=my-domain,dc=com のような文字列を組み立てる

    Try
        Dim directoryEntry As New DirectoryEntry(adPath, sDN, passWord, AuthenticationTypes.FastBind)
        ' LDAPサーバに接続できているかどうか確認する。次の構文で例外が発生するならば
        ' LDAPの認証に失敗している。
        Dim obj As Object = directoryEntry.NativeObject
    Catch ex As Exception
        Return False
    End Try

    Return True
End Function

過去に同様の質問があったようです。

http://www.atmarkit.co.jp/bbs/phpBB/viewtopic.php?topic=29307&forum=7

編集 履歴 (0)
  • お返事ありがとうございます。
    今のところGetObject→OpenDSObjectの流れで認証しています。
    (結局VBScriptと似たような感じで・・・)
    教えてくださった方法でうまくいくか
    まだ試していません。
    -
  • 教えていただいた方法でうまくいきました。
    rootdnでなんでもできるのかと思っていて、
    FindAllを使っていたのがまずかったのでしょうか・・・
    -

oton10000さん

ありがとうございます。教えていただいた方法でうまくいきました。
今のところ優柔不断にどちらにするか決めかねています。

Private Sub btnLogin_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnLogin.Click

    Dim strServerName As String
    Dim strSearchStyle As String
    Dim strUserName As String = tbxAccount.Text
    Dim strPassword As String = tbxPassword.Text
    Dim strDomainName As String
    Dim XML_DS As New DataSet

    Try

 '略 このへん設定ファイルからサーバ名やDN等取得しています。   strSearchStyle = CStr(XML_DS.Tables(0).Rows(0).Item("SearchStyle"))
strServerName = CStr(XML_DS.Tables(0).Rows(0).Item("ServerName"))
strDomainName = CStr(XML_DS.Tables(0).Rows(0).Item("SearchDomain"))

        Select Case strSearchStyle
            Case "0" 'GetObject,OpenDSObjectを使用
                Dim objNS As Object = GetObject("LDAP:")
                Dim objOpenObject As Object = objNS.OpenDSObject("LDAP://" & strServerName, "uid=" & Trim(strUserName) & "," & strDomainName, Trim(strPassword), 0)
            Case "1" 'DirectoryEntryを使用

                Dim adPath As String = "LDAP://" & strServerName & "/" & strDomainName
                Dim sDN As String = "uid=" & Trim(strUserName) & "," & strDomainName
                Dim directoryEntry As New DirectoryEntry(adPath, sDN, strPassword, AuthenticationTypes.FastBind)
                ' LDAPサーバに接続できているかどうか確認する。次の構文で例外が発生するならば
                ' LDAPの認証に失敗している。
                Dim obj As Object = directoryEntry.NativeObject


        End Select


        MsgBox("認証成功!")
    Catch ex As Exception

        '判定するのならここでするしかない(エラーメッセージ
        MsgBox("認証失敗!" & "[" & ex.Message & "]" & ex.StackTrace)

    End Try

End Sub
編集 履歴 (0)
  • 上記の2つの方式ですが、LDAPサーバがメンテナンス中や、ネットワークが不安定/不通のときの対応が不安です。タイムアウトの時間等設定できればよいのですが。

    もう少し検証してみます。
    -
  • 無事実装までこぎつけることができました。ありがとうございました。 -

oton10000さん
ありがとうございます。
試してみます。

今のところVBScriptの例等マネて
http://www.upken.jp/kb/vbscript-openldap-ldaps.html
以下のような形で実装していますが・・・

Private Sub btnLogin_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnLogin.Click

    Dim strServerName As String
    Dim strUserName As String = tbxAccount.Text
    Dim strPassword As String = tbxPassword.Text
    Dim strDomainName As String
    Dim XML_DS As New DataSet

    Try

      '略 このへん設定ファイルからサーバ名やDN等取得しています。
strServerName = CStr(XML_DS.Tables(0).Rows(0).Item("ServerName"))
strDomainName = CStr(XML_DS.Tables(0).Rows(0).Item("SearchDomain"))

        Dim objNS As Object = GetObject("LDAP:")
        Dim objOpenObject As Object = objNS.OpenDSObject("LDAP://" & strServerName, "uid=" & Trim(strUserName) & "," & strDomainName, Trim(strPassword), 0)

        MsgBox("認証成功!")
    Catch ex As Exception

        '例外の内容を判定するのならここでするしかない
        MsgBox("認証失敗!" & "[" & ex.Message & "]" & ex.StackTrace)

    End Try

End Sub
編集 履歴 (0)

自己レスです。
下記のようにVBAのコードをマネてGetObjectを使えば
アクセスできます。(アカウントとパスワードを
渡すやり方ではなく、Anonymousでおそらく接続していますが)

問題は、これがお行儀の悪い方法であるということと、
(DirectoryServicesを使うのが正式な方法であるという認識です)
環境によってはつながらないことがあるのではないかという
危惧です。

Public Class frmLogin

Private Sub frmLogin_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
    Dim ht As New Hashtable
    ht = GetAllUsers()
    For i As Integer = 0 To ht.Count


    Next i

End Sub



Public Function GetAllUsers() As Hashtable

    'To retrieve list of all  LDAP users 
    Dim RetArray As New Hashtable
    Dim oPath As String = "LDAP://localhost/ou=Users,dc=my-domain,dc=com"
    Dim adsGroup As Object
    Dim strUid As String
    Dim strName As String

    Try

        adsGroup = GetObject(oPath)

        For Each oResult In adsGroup

            System.Diagnostics.Debug.WriteLine(oResult.uid)
            strUid = oResult.uid
            strName = oResult.sn
            RetArray.Add(strUid, strName)
        Next

    Catch e As Exception

        Return RetArray

    End Try

    Return RetArray

End Function

End Class

編集 履歴 (0)
ウォッチ

この質問への回答やコメントをメールでお知らせします。