Datenschutz

mmi consult - tipps und tricks blog

 6.5.x  7.x  8.0.x  8.5.x 

Datenbankrollen stets aktuell zum Code halten

Manfred Meise  2 April 2012 13:06:42
 
Datenbankentwickler können in Domino Datenbanken Rollen einsetzen, um bestimmte anwendungsspezifische Funktionen zu steuern. Leider kann es z.B. beim Kopieren von Schablonen oder Datenbanken geschehen, dass die ACL nicht mit kopiert wird und die Rollendefinitionen verloren gehen, Eine nachträgliche (erneute) Einrichtung der Rollen durch den Domino Administrator ist zwar möglich, setzt jedoch eine saubere Dokumentation der verwendeten Rollen voraus (unter Berücksichtigung der Groß-/Kleinschreibung der Rollennamen) damit die gewünschte Funktion gewährleistet ist.

Um diesem Problem aus dem Weg zu gehen, setze ich in Datenbanken mit Rollen stets das nachfolgende Datenbankskript ein (in etwas abgewandelter / detaillierter Form) ein, um durch Code des Anwendungsentwicklers (der wohl seine Rollennamen kennen sollte) die ACL in der Laufzeitumgebung zu analysieren und ggf. zu pflegen. Fehlen Rollendefinitionen (und sind gar überflüssige enthalten) und Ist der aktuelle Benutzer mit Manager Berechtigung ausgestattet, so pflegt dieses Skript direkt die ACL, ansonsten wird mindesten ein Hinweis ausgegeben.

Hat sich in der Praxis einfach bewährt !!! 

 
' 
' This Database Script insures up-to-date database Roles as required/assumed by the developer 
'  
' Note: Update constant in PostOpen to match your application 
' 
' Author: Manfred.Meise@mmi-consult.de (http://www.mmi-consult.de/faq) 
' 
 
Sub Postopen(Source As Notesuidatabase) 
         
        Const strRequiredRoles = "[Configuration]:[EditAllDocs]:[TestRolle]"                'Required Roles in application 
         
        Call VerifyRoles (Source.Database, Split(strRequiredRoles, ":")) 
         
End Sub 
 
Sub VerifyRoles (db As NotesDatabase, strRequireRoles As Variant) 
         
        Dim vRolesCurrent        As Variant 
        Dim vRolesMissing        As Variant 
        Dim vRolesObsolete        As Variant 
         
        Dim strErrorMsg         As String 
         
        Const MB_ICONEXCLAMATION = 48 
         
        '--------------------------------------------- 
        ' Specify and Verify Roles in ACL 
        '--------------------------------------------- 
        If Ubound(strRequireRoles) >= 0 Then 
                ' Get list of missing or obsolete roles 
                vRolesCurrent        db.acl.Roles 
                vRolesMissing         = Fulltrim(Arrayreplace (strRequireRoles, vRolesCurrent, "")) 
                vRolesObsolete        Fulltrim(Arrayreplace (vRolesCurrent, strRequireRoles, "")) 
                 
                If (vRolesMissing(0) <> "") Or (vRolesObsolete(0) <> "") Then 
                        'Prepare resulting message 
                        If vRolesMissing(0) <> "" Then  
                                strErrorMsg = "Fehlende ACL-Rollen in Datenbank:" & _ 
                                Chr(10) & Join (vRolesMissing, Chr(10)) & Chr(10) 
                        End If                                         
                         
                        If (vRolesObsolete(0) <> "") Then 
                                If strErrorMsg <> "" Then strErrorMsg = strErrorMsg & Chr(10) 
                                strErrorMsg = "Überflüssige ACL-Rollen in Datenbank:" & _ 
                                Chr(10) & Join (vRolesObsolete, Chr(10))  & Chr(10) 
                        End If 
                         
                        'Roles are missing in ACL of this database 
                        If db.CurrentAccessLevel = ACLLEVEL_MANAGER Then 
                                'We can add missing roles 
                                Call setRoles (db, Arrayunique(strRequireRoles)) 
                                Messagebox strErrorMsg & "ACL wurden automatisch angepasst", MB_ICONEXCLAMATION,"" 
                                 
                        Else 
                                'Notify administrator to add missing roles 
                                Messagebox strErrorMsg & "Bitte den Systemadministrator benachrichtigen", MB_ICONEXCLAMATION,"" 
                                 
                        End If 
                End If 
        End If                 
         
End Sub 
 
 
Sub SetRoles (db As NotesDatabase, roles As Variant) 
         
        Dim acl                 As NotesACL 
        Dim bNeedToSave         As Boolean 
        Dim vCurrentRoles         As Variant 
        Dim vTargetRoles         As Variant 
         
        bNeedToSave         = False 
         
        vTargetRoles         = Roles 
        vCurrentRoles         = db.ACL.Roles 
        If Not Isarray (vCurrentRoles) Then Redim vCurrentRoles(0) 
         
        Set acl = db.ACL 
         
                'Add missing roles 
        Forall r In vTargetRoles 
                 
                If Isnull (Arraygetindex(vCurrentRoles, r)) Then 
                        Call acl.AddRole (r)                                 
                        bNeedToSave = True 
                End If 
                 
        End Forall 
         
                'Remove obsolete Roles 
        Forall r In vCurrentRoles 
                If Not r = "" Then                                         
                        If Isnull (Arraygetindex(vTargetRoles, r)) Then 
                                Call acl.DeleteRole (r)                                 
                                bNeedToSave = True 
                        End If 
                End If 
        End Forall 
         
        If bNeedToSave Then Call acl.Save 
         
SingleExit: 
        Exit Sub 
         
End Sub