Как получить список всех имен, групп и ролей пользователя?

Тема в разделе "Библиотеки скриптов", создана пользователем Elena Nefedova, 27 дек 2006.

Статус темы:
Закрыта.
  1. Elena Nefedova

    Elena Nefedova Гость

    Ответ:
    Следующая функция позволяет получить список общего и канонического имен пользователя, общих имен всех подразделений, организации и страны пользователя,
    плюс в рамках текущего сервера - всех его групп,
    плюс в рамках текущей базы данных - список всех ролей, которые пользователю назначены индивидуально или через группы (для получения ролей флаг b_include_roles установить в True)
    Проверяется соответствие спискам "Access Server" и "Not Access Server"

    Примечание: Код не тестировался для Web

    [codebox]
    Function get_names_list(Byval s_user$,
    Byval b_include_roles As Boolean) As Variant
    ' Created by Elena Nefedova, Fors-Banking Systems
    On Error Goto ErrLab
    Dim FR As Variant, ar_org As Variant
    Dim s_country$

    ' получение объекта NotesName
    + всех шаблонов подразделений, шаблона организации и общего шаблона:
    */DEPARTMENT01/FORS; */FORS; *
    Redim FR(1)
    Dim nnm As New NotesName(s_user)
    FR(0) = nnm.Canonical
    FR(1) = nnm.Common
    Redim ar_org(20) ' возьмем побольше
    ar_org(0) = "*"
    s_country = nnm.Country
    If s_country <> "" Then
    s_country = "/C=" + s_country
    ar_org(1) = "*" + s_country
    End If
    ar_org(2) = "*/O=" + nnm.Organization + s_country
    If nnm.OrgUnit1 <> "" Then ar_org(3) =
    "*/OU=" + nnm.OrgUnit1 + "/O=" + nnm.Organization + s_country
    If nnm.OrgUnit2 <> "" Then ar_org(4) =
    "*/OU=" + nnm.OrgUnit2 + "/OU=" + nnm.OrgUnit1 + "/O=" + nnm.Organization + s_country
    If nnm.OrgUnit3 <> "" Then ar_org(5) =
    "*/OU=" + nnm.OrgUnit3 + "/OU=" + nnm.OrgUnit2 + "/OU=" + nnm.OrgUnit1 + "/O=" + nnm.Organization + s_country
    If nnm.OrgUnit4 <> "" Then ar_org(6) =
    "*/OU=" + nnm.OrgUnit4 + "/OU=
    " + nnm.OrgUnit3 + "/OU=" + nnm.OrgUnit2 + "/OU=" + nnm.OrgUnit1 + "/O=" + nnm.Organization + s_country
    ar_org = Fulltrim(ar_org) ' массив хранит все иерархические организационные уровни
    FR = Arrayunique(Arrayappend(FR, ar_org))
    ' Получение текущей директории Domino
    Dim sess As New NotesSession, curdb As NotesDatabase, doc As NotesDocument
    Set curdb = sess.CurrentDatabase
    Dim s_server$, s_filename$
    If sess.IsOnServer Then
    s_server = curdb.Server
    Else
    Dim v_server As Variant
    Set doc = New NotesDocument(curdb)
    v_server = Evaluate({@MailDbName}, doc)
    s_server = v_server(0)
    End If
    s_filename = "names.nsf"
    Dim dbnames As NotesDatabase, view As NotesView, grcol As NotesDocumentCollection
    Dim gr%, s_gr$, ar_group As Variant
    Set dbnames = New NotesDatabase(s_server, s_filename)
    If Not dbnames.IsOpen Then Call dbnames.Open("", "")
    If dbnames.IsOpen Then
    ' получение всех групп пользователя в данной директории домино
    Set view = dbnames.GetView("($ServerAccess)")
    If view Is Nothing Then
    Goto Result_Lab ' результат - только организация и подразделения
    Set grcol = view.GetAllDocumentsByKey(Lcase(s_user))
    Redim ar_group(0)
    For gr = grcol.Count To 1 Step -1
    Set doc = grcol.GetNthDocument(gr)
    If Not (doc Is Nothing) Then
    ar_group = Arrayappend(ar_group, doc.GetItemValue("ListName"))
    End If
    Next gr
    ar_group = Arrayunique(Fulltrim(ar_group))
    'НЕ ИСКЛЮЧЕН ЛИ ПОЛЬЗОВАТЕЛЬ ИЛИ ГРУППА ИЗ ДОСТУПА К СЕРВЕРУ ???
    Set view = dbnames.GetView("($Servers)")
    If view Is Nothing Then Goto Result_Lab
    ' результат - только организация и подразделения (не рассмотрены ограничения доступа к текущему серверу)
    Set doc = view.GetDocumentByKey(s_server, True)
    If doc Is Nothing Then Goto Result_Lab ' результат - только организация и подразделения
    ' Пользователь ИЛИ его группа должны быть явно включены в поле AllowAccess ЛИБО это поле должно быть пустым
    Dim v_0 As Variant, v_1 As Variant, v_2 As Variant, v_3 As Variant
    v_0 = Arrayappend(FR, ar_group) ' временно для сравнений - список имен/групп пользователя
    v_1 = doc.AllowAccess
    If Not Isarray(v_1) Then Redim v_1(0)
    If v_1(0) <> "" Then
    v_2 = Fulltrim(Arrayreplace(v_0, v_1, ""))
    ' список имен/групп пользователя, не вошедших в список доступа к серверу
    v_3 = Fulltrim(Arrayreplace(v_0, v_2, ""))
    ' пересечение списка доступа к серверу и списка имен/групп пользователя
    If v_3(0) = "" Then
    Redim FR(0)
    Goto Result_Lab ' Выходим с пустым списком имен, так как пользователь не имеет доступа к серверу
    End If
    End If
    ' Пользователь И все его группы должны отсутствовать в поле DenyAccess
    v_1 = doc.DenyAccess
    If Not Isarray(v_1) Then Redim v_1(0)
    v_2 = Fulltrim(Arrayreplace(v_0, v_1, "")) ' список имен/групп пользователя, не вошедших в список запрета доступа к серверу
    v_3 = Fulltrim(Arrayreplace(v_0, v_2, "")) ' пересечение списка запрета доступа к серверу и списка имен/групп пользователя
    If v_3(0) <> "" Then ' пользователю s_user запрещен доступ к серверу явно или через группу!!
    Redim FR(0)
    Goto Result_Lab ' Выходим с пустым списком имен, так как пользователь не имеет доступа к серверу
    End If
    Erase FR
    FR = v_0 ' Чтоб дважды не рассчитывать
    End If

    ' получение всех ролей данного пользователя или его групп в рамках текущей базы
    Dim cur_acl As NotesACL, aclentry As NotesACLEntry, ar_entry As Variant
    Dim n_type%, m%
    Dim ar_roles As Variant
    Set view = dbnames.GetView("($Users)")
    If view Is Nothing Then Goto Result_Lab
    Set grcol = view.GetAllDocumentsByKey(Lcase(s_user))
    If grcol.Count = 0 Then
    n_type = -1 ' это Anonymous
    Redim FR(0) ' следовательно, он не принадлежит ни к подразделениям, ни к группам
    Else
    n_type = 0 ' начнем последовательно искать имена пользователя в ACL
    End If
    If b_include_roles Then ' анализируем ACL, если включен флаг
    Set cur_acl = curdb.ACL
    Do While n_type < 4
    Select Case n_type
    Case -1 ' Anonymous
    ar_entry = Split("Anonymous", ";")
    Case 0 'canonical
    ar_entry = Split(nnm.Canonical, ";")
    Case 1 ' common
    ar_entry = Split(nnm.Common, ";")
    Case 2 ' все группы (объединенный доступ); группа "*" не встречается самостоятельно в ACL, вместо нее добавляется пользователь -Default- (см. далее)
    ar_entry = Arrayappend(ar_org, ar_group)
    Case 3 ' -Default-
    ar_entry = Split("-Default-", ";")
    Case Else
    Exit Do
    End Select
    Redim ar_roles(0)
    For m = Ubound(ar_entry) To 0 Step -1
    Set aclentry = cur_acl.GetEntry(ar_entry(m))
    If Not aclentry Is Nothing Then
    n_type = 99 ' признак того, что в ACL найдена соотв. запись
    ar_roles = Arrayappend(ar_roles, aclentry.Roles )
    End If
    Next m
    If n_type = 99 Then
    ar_roles = Arrayunique(Fulltrim(ar_roles))
    FR = Arrayappend(FR, ar_roles)
    End If
    If n_type = -1 Then
    n_type = 77 ' чтобы выйти после обработки Anonymous
    Else
    n_type = n_type + 1
    End If
    Loop
    End If

    Result_Lab:
    ' результат
    get_names_list = Fulltrim(FR)
    ' КОНЕЦ ПОДПРОГРАММЫ
    EndLab:
    Exit Function
    ErrLab:
    On Error Resume Next
    Goto EndLab ' вернется пустое значение Variant (не массив)
    End Function[/codebox]

    PS: Спасибо Oshmianski за помощь в тестировании
    29.12.06 PPS: Дополнительное спасибо Oshmianski за замеченную в коде помарку :unsure:


    09.12.07 : Уточнен расчет доступа к текущему серверу
     
  2. GROMILA

    GROMILA Well-Known Member

    Регистрация:
    8 апр 2004
    Сообщения:
    297
    Симпатии:
    0
    Хотел заюзать сей скрипт для получения списка групп, в которые входит пользователь.
    Сразу наткнулся на неточность.

    Глянул код.
    Код (Text):
     ' получение всех групп пользователя в данной директории домино
    Set view = dbnames.GetView("($ServerAccess)")
    If view Is Nothing Then Goto Result_Lab ' результат - только организация и подразделения
    Set grcol = view.GetAllDocumentsByKey(Lcase(s_user))

    Поиск идет по s_user, а представление "($ServerAccess)" содержит каноническую форму.
    Следовательно искать нужно по FR(0) или nnm.Canonical

    Вообще, следовало бы написать пример вызова и коммент к параметрам!!!!
     
  3. nvyush

    nvyush Lotus team
    Lotus team

    Регистрация:
    22 апр 2009
    Сообщения:
    2.317
    Симпатии:
    0
    Тема с кучей вариантов получения списка групп пользователя:
    Вхождение юзера в группу
    Допиленный для кроссплатформенности вариант с http://www.keysolutions.com/NotesFAQ/howlist.html:
    <div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">LS библиотека BuildNamesList</div></div><div class="sp-body"><div class="sp-content">
    Код (LotusScript):
    'BuildNamesList:

    Option Public
    Option Declare

    Private Const ASCII_NUL = 0&
    Private Const NLS_NULLTERM = -1%

    Private NAMES_LIST_OFFSET As Long
    Private PLATFORM_TYPE As Long

    Private Const PLATFORM_TYPE_WIN32   = &H00000004 'Windows 32
    Private Const PLATFORM_TYPE_MACX    = &H00000200 'Mac OS X
    Private Const PLATFORM_TYPE_LINUX   = &H00010000 'UNIX/Linux

    Private Const LIB_NOTES_W32 = "nnotes.dll"
    Private Const LIB_NOTES_LINUX = "libnotes.so"
    Private Const LIB_NOTES_MACX = "libnotes.dylib"

    'Win32 routine definitions
    Declare Private Function w32_OSLockObject Lib LIB_NOTES_W32 Alias "OSLockObject" (Byval handle As Long) As Long
    Declare Private Sub w32_OSUnlockObject Lib LIB_NOTES_W32 Alias "OSUnlockObject" (Byval handle As Long)
    Declare Private Sub w32_OSMemFree Lib LIB_NOTES_W32 Alias "OSMemFree" (Byval handle As Long)

    Declare Private Function w32_NSFBuildNamesList Lib LIB_NOTES_W32 Alias "NSFBuildNamesList" (Byval userName As Lmbcs String, Byval dwFlags As Long, rethNamesList As Long) As Integer

    Declare Private Sub w32_ODSReadMemory Lib LIB_NOTES_W32 Alias "ODSReadMemory" (pSRC As Long, Byval destType As Integer, pDest As Any, Byval iterations As Integer)
    Declare Private Sub w32_ODSReadMemory_String Lib LIB_NOTES_W32 Alias "ODSReadMemory" (pSRC As Long, Byval destType As Integer, Byval pDest As Lmbcs String, Byval iterations As Integer)

    Declare Private Sub w32_NLS_string_bytes Lib LIB_NOTES_W32 Alias "NLS_string_bytes" (Byval pString As Long, Byval NumChars As Integer, pNumBytes As Integer, Byval pInfo As Long)
    Declare Private Sub w32_NLS_string_chars Lib LIB_NOTES_W32 Alias "NLS_string_chars" (Byval pString As Long, Byval NumBytes As Integer, pNumChars As Integer, Byval pInfo As Long)
    Declare Private Function w32_OSGetLMBCSCLS Lib LIB_NOTES_W32 Alias "OSGetLMBCSCLS" () As Long

    'Linux/UNIX routine definitions
    Declare Private Function lnx_OSLockObject Lib LIB_NOTES_LINUX Alias "OSLockObject" (Byval handle As Long) As Long
    Declare Private Sub lnx_OSUnlockObject Lib LIB_NOTES_LINUX Alias "OSUnlockObject" (Byval handle As Long)
    Declare Private Sub lnx_OSMemFree Lib LIB_NOTES_LINUX Alias "OSMemFree" (Byval handle As Long)

    Declare Private Function lnx_NSFBuildNamesList Lib LIB_NOTES_LINUX Alias "NSFBuildNamesList" (Byval userName As Lmbcs String, Byval dwFlags As Long, rethNamesList As Long) As Integer

    Declare Private Sub lnx_ODSReadMemory Lib LIB_NOTES_LINUX Alias "ODSReadMemory" (ppSRC As Long, Byval destType As Integer, pDest As Any, Byval iterations As Integer)
    Declare Private Sub lnx_ODSReadMemory_String Lib LIB_NOTES_LINUX Alias "ODSReadMemory" (pSRC As Long, Byval destType As Integer, Byval pDest As Lmbcs String, Byval iterations As Integer)

    Declare Private Sub lnx_NLS_string_bytes Lib LIB_NOTES_LINUX Alias "NLS_string_bytes" (Byval pString As Long, Byval NumChars As Integer, pNumBytes As Integer, Byval pInfo As Long)
    Declare Private Sub lnx_NLS_string_chars Lib LIB_NOTES_LINUX Alias "NLS_string_chars" (Byval pString As Long, Byval NumBytes As Integer, pNumChars As Integer, Byval pInfo As Long)
    Declare Private Function lnx_OSGetLMBCSCLS Lib LIB_NOTES_LINUX Alias "OSGetLMBCSCLS" () As Long

    'Mac OS X routine definitions
    Declare Private Function macx_OSLockObject Lib LIB_NOTES_MACX Alias "OSLockObject" (Byval handle As Long) As Long
    Declare Private Sub macx_OSUnlockObject Lib LIB_NOTES_MACX Alias "OSUnlockObject" (Byval handle As Long)
    Declare Private Sub macx_OSMemFree Lib LIB_NOTES_MACX Alias "OSMemFree" (Byval handle As Long)

    Declare Private Function macx_NSFBuildNamesList Lib LIB_NOTES_MACX Alias "NSFBuildNamesList" (Byval userName As Lmbcs String, Byval dwFlags As Long, rethNamesList As Long) As Integer

    Declare Private Sub macx_ODSReadMemory Lib LIB_NOTES_MACX Alias "ODSReadMemory" (pSRC As Long, Byval destType As Integer, pDest As Any, Byval iterations As Integer)
    Declare Private Sub macx_ODSReadMemory_String Lib LIB_NOTES_MACX Alias "ODSReadMemory" (pSRC As Long, Byval destType As Integer, Byval pDest As Lmbcs String, Byval iterations As Integer)

    Declare Private Sub macx_NLS_string_bytes Lib LIB_NOTES_MACX Alias "NLS_string_bytes" (Byval pString As Long, Byval NumChars As Integer, pNumBytes As Integer, Byval pInfo As Long)
    Declare Private Sub macx_NLS_string_chars Lib LIB_NOTES_MACX Alias "NLS_string_chars" (Byval pString As Long, Byval NumBytes As Integer, pNumChars As Integer, Byval pInfo As Long)
    Declare Private Function macx_OSGetLMBCSCLS Lib LIB_NOTES_MACX Alias "OSGetLMBCSCLS" () As Long

    Sub Initialize
    Dim ThisSession As New NotesSession
    Select Case ThisSession.Platform
    Case "Windows/32"
    PLATFORM_TYPE = PLATFORM_TYPE_WIN32
    NAMES_LIST_OFFSET = 14
    Case "Linux", "UNIX"
    PLATFORM_TYPE = PLATFORM_TYPE_LINUX
    NAMES_LIST_OFFSET = 16
    Case "Macintosh"
    If ThisSession.NotesBuildVersion > 322 Then
    PLATFORM_TYPE = PLATFORM_TYPE_MACX
    NAMES_LIST_OFFSET = 14
    Else
    End If
    End Select
    End Sub
    Private Function capiOSLockObject(Byval handle As Long) As Long
    Select Case PLATFORM_TYPE
    Case PLATFORM_TYPE_WIN32
    capiOSLockObject = w32_OSLockObject(handle)
    Case PLATFORM_TYPE_MACX
    capiOSLockObject = macx_OSLockObject(handle)
    Case PLATFORM_TYPE_LINUX
    capiOSLockObject = lnx_OSLockObject(handle)
    End Select
    End Function


    Private Sub capiOSUnLockObject(handle As Long)
    Select Case PLATFORM_TYPE
    Case PLATFORM_TYPE_WIN32
    Call w32_OSUnLockObject(handle)
    Case PLATFORM_TYPE_MACX
    Call macx_OSUnLockObject(handle)
    Case PLATFORM_TYPE_LINUX
    Call lnx_OSUnLockObject(handle)
    End Select
    End Sub


    Private Sub capiOSMemFree(Byval handle As Long)
    Select Case PLATFORM_TYPE
    Case PLATFORM_TYPE_WIN32
    Call w32_OSMemFree(handle)
    Case PLATFORM_TYPE_MACX
    Call macx_OSMemFree(handle)
    Case PLATFORM_TYPE_LINUX
    Call lnx_OSMemFree(handle)
    End Select
    End Sub
    Private Function capiNSFBuildNamesList(userName As String, Byval dwFlags As Long, rethNamesList As Long) As Integer
    Select Case PLATFORM_TYPE
    Case PLATFORM_TYPE_WIN32
    capiNSFBuildNamesList = w32_NSFBuildNamesList(userName, dwFlags, rethNamesList)
    Case PLATFORM_TYPE_MACX
    capiNSFBuildNamesList = macx_NSFBuildNamesList(userName, dwFlags, rethNamesList)
    Case PLATFORM_TYPE_LINUX
    capiNSFBuildNamesList = lnx_NSFBuildNamesList(userName, dwFlags, rethNamesList)
    End Select
    End Function


    Private Sub capiODSReadMemory2Integer(pSRC As Long, pDest As Integer, Byval iterations As Integer)
    Const destType = 0%
    Select Case PLATFORM_TYPE
    Case PLATFORM_TYPE_WIN32
    Call w32_ODSReadMemory(pSRC, destType, pDest, iterations)
    Case PLATFORM_TYPE_MACX
    Call macx_ODSReadMemory(pSRC, destType, pDest, iterations)
    Case PLATFORM_TYPE_LINUX
    Call lnx_ODSReadMemory(pSRC, destType, pDest, iterations)
    End Select
    End Sub
    Private Sub capiODSReadMemory2String(pSRC As Long, pDest As String, Byval iterations As Integer)
    Const destType = 3%
    Select Case PLATFORM_TYPE
    Case PLATFORM_TYPE_WIN32
    Call w32_ODSReadMemory_String(pSRC, destType, pDest, iterations)
    Case PLATFORM_TYPE_MACX
    Call macx_ODSReadMemory_String(pSRC, destType, pDest, iterations)
    Case PLATFORM_TYPE_LINUX
    Call lnx_ODSReadMemory_String(pSRC, destType, pDest, iterations)
    End Select
    End Sub
    Private Sub capiNLS_string_bytes(Byval pString As Long, Byval NumChars As Integer, pNumBytes As Integer, Byval pInfo As Long)
    Select Case PLATFORM_TYPE
    Case PLATFORM_TYPE_WIN32
    Call w32_NLS_string_bytes(pString, NumChars, pNumBytes, pInfo)
    Case PLATFORM_TYPE_MACX
    Call macx_NLS_string_bytes(pString, NumChars, pNumBytes, pInfo)
    Case PLATFORM_TYPE_LINUX
    Call lnx_NLS_string_bytes(pString, NumChars, pNumBytes, pInfo)
    End Select
    End Sub
    Private Sub capiNLS_string_chars(Byval pString As Long, Byval NumBytes As Integer, pNumChars As Integer, Byval pInfo As Long)
    Select Case PLATFORM_TYPE
    Case PLATFORM_TYPE_WIN32
    Call w32_NLS_string_chars(pString, NumBytes, pNumChars, pInfo)
    Case PLATFORM_TYPE_MACX
    Call macx_NLS_string_chars(pString, NumBytes, pNumChars, pInfo)
    Case PLATFORM_TYPE_LINUX
    Call lnx_NLS_string_chars(pString, NumBytes, pNumChars, pInfo)
    End Select
    End Sub
    Private Function capiOSGetLMBCSCLS() As Long
    Select Case PLATFORM_TYPE
    Case PLATFORM_TYPE_WIN32
    capiOSGetLMBCSCLS = w32_OSGetLMBCSCLS()
    Case PLATFORM_TYPE_MACX
    capiOSGetLMBCSCLS = macx_OSGetLMBCSCLS()
    Case PLATFORM_TYPE_LINUX
    capiOSGetLMBCSCLS = lnx_OSGetLMBCSCLS()
    End Select
    End Function
    Public Function BuildNamesList(userName As String) As Variant
    On Error Goto ErrorHandler
    Dim numEntries As Integer
    Dim numBytes As Integer
    Dim numChars As Integer
    Dim bufffer As String
    Dim hNamesList As Long
    Dim pNamesList As Long
    Dim pNLS_INFO As Long
    Dim ptr As Long

    'get pointer to built user names list
    Call capiNSFBuildNamesList(username, 0, hNamesList)

    If hNamesList > 0 Then     
    'lock names list structure, get memory pointer
    pNamesList = capiOSLockObject(hNamesList)
    'get number of entries (ODSReadMemory shifts ptr to the next byte !)
    ptr = pNamesList
    Call capiODSReadMemory2Integer(ptr, numEntries, 1)
    'get NLS_INFO structure pointer
    pNLS_INFO = capiOSGetLMBCSCLS
    'skip to first entry
    ptr = pNamesList + NAMES_LIST_OFFSET
    'prepare destination array
    Redim entries(numEntries - 1) As String
    Forall entry In entries
    'get entry size in bytes           
    Call capiNLS_string_bytes(ptr, NLS_NULLTERM, numBytes, pNLS_INFO)
    'get entry size in chars
    Call capiNLS_string_chars(ptr, NLS_NULLTERM, numChars, pNLS_INFO)
    If numBytes > 0 Then
    'prepare buffer
    bufffer = String$(numBytes, ASCII_NUL)
    'read entry to the buffer (bytes!), ODSReadMemory shifts ptr to the next entry
    Call capiODSReadMemory2String(ptr, bufffer, numBytes)
    'read string from buffer (chars!)
    entry = Left$(bufffer, numChars)
    End If
    End Forall
    'ulock names list structure
    Call capiOSUnlockObject(hNamesList)
    'release memory
    Call capiOSMemFree(hNamesList)
    End If
    QUIT:
    BuildNamesList = entries
    Exit Function
    ErrorHandler:
    Redim entries(0) As String
    Resume QUIT
    End Function
    Причина допиливания — апишная функция NSFBuildNamesList берёт группы из локальной АК, а далеко не все серверы виндовые.
    Для пользования нужно вызывать серверного агента, сохраняющего результат BuildNamesList в поле документа.
     
Загрузка...
Статус темы:
Закрыта.

Поделиться этой страницей