| Author |
 Topic  |
|
|
lfessler
26 Posts |
 Posted - 06/28/2017 : 12:01:03
|
I have Windows AD Groups that were added as Roles in ReportPortal. Is there a way to sync group membership as a scheduled task? I see the option in the admin security settings to sync membership when a Windows User logs in, but I have several users that receive scheduled reports and rarely, if ever, log in. We send all of our report subscriptions to the Roles so I'd love to figure out how to get this working.
If not, I'm planning to create users for each AD distribution group that I want to send reports to and then assign the subscription to that AD distro group user.
Thanks!
|
|
|
admin
1635 Posts |
Posted - 06/29/2017 : 04:43:28
|
Do you want this script to:
1. Create/delete RP users based on Windows groups tied to RP roles
2. Add/remove RP users in RP roles
3. Both |
 |
|
|
lfessler
26 Posts |
Posted - 06/29/2017 : 06:47:18
|
#3. Both, please.
If that is not possible, then #2, Add/Remove users in Roles.
Thanks. |
|
|
|
admin
1635 Posts |
Posted - 06/30/2017 : 22:52:30
|
'Save the below VB script into file SynchUsers.vbs.
'Copy the file to C:\inetpub\wwwroot\ReportPortal
'If you need to run this file in another location
'make sure that xmla.udl is copied along with this file
Dim cn: Set cn = CreateObject("ADODB.Connection")
cn.Open "File Name=xmla.udl"
Synch
cn.Close
WScript.Echo "Done!"
Sub Synch()
Dim oNetwork: Set oNetwork = CreateObject("WScript.Network")
Dim sDomainName: sDomainName = GetSingleSqlValue("SELECT ParamValue FROM AppSettings WHERE Param = 'NtDomainName'")
If sDomainName = "" Then
sDomainName = oNetwork.UserDomain
End If
Set oDomain = GetObject("WinNT://" & sDomainName)
Dim sUsers: sUsers = ""
Dim dic: Set dic = CreateObject("Scripting.Dictionary")
Dim rs: Set rs = CreateObject("ADODB.Recordset")
rs.CursorLocation = 3 'adUseClient
rs.CursorType = 3 'adOpenStatic
Dim iRoleId, sGroupName, sUserIds
Dim oGroup: Set oGroup = Nothing
rs.Open "SELECT RoleId, RoleName FROM Role where IsNtBased = 1", cn
Do While Not rs.EOF
sUserIds = ""
iRoleId = rs("RoleId").Value & ""
sGroupName = rs("RoleName").Value & ""
On Error Resume Next
Set oGroup = oDomain.GetObject("Group", sGroupName)
If Err.number <> 0 Then
WScript.Echo Err.Description & ", Group name: " & sGroupName
Set oGroup = Nothing
Err.Clear
End If
If Not oGroup Is Nothing Then
For Each oUser In oGroup.Members
iUserId = AddUser(oUser.Name, oUser) 'Get user id, add user to DB if it does not exist
AddRole iRoleId, iUserId
if sUserIds <> "" Then sUserIds = sUserIds & ","
sUserIds = sUserIds & iUserId
If dic.Exists(iUserId) = False Then
dic.Add iUserId, True
If sUsers <> "" Then sUsers = sUsers & ","
sUsers = sUsers & iUserId
End If
Next
End If
If sUserIds <> "" Then
cn.Execute "DELETE FROM UserRole WHERE RoleId = " & iRoleId & " AND UserId not in (" & sUserIds & ")"
End If
rs.MoveNext
Loop
Set rs = Nothing
If sUsers <> "" Then
cn.Execute "DELETE FROM AppUser WHERE IsAdmin=0 and UserId not in (" & sUsers & ")"
End If
End Sub
Function GetSingleSqlValue(sSql)
Set rs = CreateObject("ADODB.Recordset")
rs.Open sSql, cn
If Not rs.EOF Then
GetSingleSqlValue = rs(0).value & ""
End If
Set rs = Nothing
End Function
Function GetUserNameNoDomain(sUserName)
Dim iPos: iPos = InStr(1, sUserName, "\")
If iPos = 0 Then
GetUserNameNoDomain = sUserName
Else
GetUserNameNoDomain = Mid(sUserName,iPos+1,len(sUserName))
End If
End Function
Function PadQuotes(s)
If s = "" Then
PadQuotes = ""
Exit Function
End If
PadQuotes = Replace(s, "'", "''")
End Function
Sub AddRole(sRoleId, iUserId)
If sRoleId = "" Or iUserId = "" Then
Exit Sub
End If
If GetSingleSqlValue("SELECT count(*) FROM UserRole WHERE UserId=" & iUserId & " AND RoleId=" & sRoleId) <> "0" Then
Exit Sub
End If
cn.Execute "INSERT INTO UserRole(RoleId, UserId) VALUES(" & sRoleId & ", " & iUserId & ")"
End Sub
Function AddUser(sUserName, oUser)
'Exit if user exists
AddUser = GetSingleSqlValue("SELECT UserId FROM AppUser WHERE UserName = N'" & sUserName & "'")
If AddUser <> 0 Then
Exit Function
End If
AddUser = GetSingleSqlValue("SELECT UserId FROM AppUser WHERE LOWER(NtUserId) = N'" & lcase(sUserName) & "'")
If AddUser <> 0 Then
Exit Function
End If
AddUser = GetSingleSqlValue("SELECT UserId FROM AppUser WHERE LOWER(NtUserId) = N'" & lcase(GetUserNameNoDomain(sUserName)) & "'")
If AddUser <> 0 Then
Exit Function
End If
'Get First and Last Names
Dim sFullName: sFullName = oUser.FullName
Dim iPos: iPos = InStrRev(sFullName, " ")
Dim sFirstName: sFirstName = Trim(Left(sFullName, iPos))
Dim sLastName: sLastName = Right(sFullName, Len(sFullName) - iPos)
Dim sEmailAddress: sEmailAddress = GetEmail(sUserName, sDomainName)
Dim sPassword: sPassword= GetGuid()
Dim sSql: sSql = "UpdateAppUser @UserName = '" & PadQuotes(sUserName) & _
"', @Password = '" & PadQuotes(sPassword) & _
"', @NtUserId = '" & PadQuotes(sUserName) & _
"', @NtPassword = '" & _
"', @Email = '" & PadQuotes(sEmailAddress) & _
"', @FirstName = '" & PadQuotes(sFirstName) & _
"', @LastName = '" & PadQuotes(sLastName) & "'"
cn.Execute sSql
AddUser = GetSingleSqlValue("SELECT isnull(MAX(UserId),0) FROM AppUser")
End Function
Function GetGuid()
Dim oTypeLib: Set oTypeLib = CreateObject("Scriptlet.TypeLib")
Dim s: s = trim(oTypeLib.Guid)
GetGuid = MID(s, 2, Len(s)-4)
End Function
Function GetEmail(strAccountName , strDomainName )
On Error Resume Next
Dim adoLDAPCon: Set adoLDAPCon = CreateObject("ADODB.Connection")
adoLDAPCon.Provider = "ADsDSOObject"
adoLDAPCon.Open ("ADSI")
Dim strLDAP: strLDAP = "'LDAP://" & strDomainName & "'"
Dim adoLDAPRS: Set adoLDAPRS = adoLDAPCon.Execute("select mail from " & strLDAP & " WHERE objectClass = 'user' And samAccountName = '" & strAccountName & "'")
With adoLDAPRS
If Not .EOF Then
GetEmail = .Fields("mail")
Else
GetEmail = ""
End If
End With
adoLDAPRS.Close
adoLDAPRS = Nothing
adoLDAPCon = Nothing
End Function
|
|
|
| |
Topic |
|
|
|
Report Portal
Sync Group (Role) Membership on Schedule
