home *** CD-ROM | disk | FTP | other *** search
- #---------------------------------------------------------------------------
- #
- # (c) Cayenne Software Inc. 1997
- #
- # File: %W%
- # Author: M. van Leeuwen, E. Rijvordt
- # Description: Report on security
- # Usage in: Corporate to Phase Level
- # Options: <rolenames>
- #---------------------------------------------------------------------------
- # SccsId = %W% %G% Copyright 1997 Cayenne Software Inc.
-
- global controlled
-
- set controlled(ConfigPhaseLink) {phaseVersion}
- set controlled(ConfigVersion) {phaseVersionLinkList}
- set controlled(ControlledList) {objects}
- set controlled(Corporate) {corporateGroups modelList projectList}
- set controlled(CorporateGroup) {corporateGroupVersions}
- set controlled(CustomFile) {customFileVersionList}
- set controlled(CustomLevel) {customFileList}
- set controlled(CustomLevelVersion) {customFileVersionLinkList}
- set controlled(File) {fileVersionList}
- set controlled(Group) {groupVersionList}
- set controlled(LevelCustomFileLink) {customFileVersion}
- set controlled(Phase) {systemList}
- set controlled(PhaseSystemLink) {systemVersion}
- set controlled(PhaseVersion) {systemVersionLinkList}
- set controlled(Project) {configList configVersions}
- set controlled(System) {fileList groupList savedGroups}
- set controlled(SystemCorporateLink) {corporateGroupVersion}
- set controlled(SystemFileLink) {fileVersion}
- set controlled(SystemGroupLink) {groupVersion}
- set controlled(SystemVersion) {corporateGroupVersionLinkList
- externalLinkList
- fileVersionLinkList
- fileVersionReferenceList
- groupVersionLinkList
- propertyReferenceList}
- set controlled(Version) {object}
-
- #---------------------------------------------------------------------------
-
- # Keep these of length n
- set ALLOW "+++ "
- set DENYD "--- "
- set UNDEF "... "
- set NOACC "xxx "
-
- set TEXTLEN 80
- set NOTSPECIFIED "No access rules specified"
-
- #---------------------------------------------------------------------------
-
- Class ReportSecurity : {ReportBase} {
- constructor
-
- attribute actions
- attribute roles
-
- method findActions
- method printInfo
- method doReport
-
- method controlledObjects
- method control
- method baseClassesOf
-
- method corporateReport
- method projectReport
- method configReport
- method phaseReport
- method systemReport
- method fileReport
- }
-
-
- constructor ReportSecurity {class this} {
- set this [ReportBase::constructor $class $this]
-
- set allRoles [query -s roles.name [$cc currentCorporate]]
-
- if ![lempty $Options] {
- $this roles $Options
- foreach role [$this roles] {
- if { [lsearch $allRoles $role] == -1 } {
- [$this report] print "** Non existing role '$role' **" line
- exit
- }
- }
- } else {
- $this roles $allRoles
- }
-
- if { [llength [$this roles]] == 1 } {
- $this reportName "Security on Role [$this roles]"
- } else {
- $this reportName "Security"
- }
- $this actions { controlAction createAction destroyAction readAction \
- modifyAction insertAction removeAction freezeAction \
- unfreezeAction modifyStatusAction}
- return $this
- }
-
- method ReportSecurity::findActions {this object roles} {
- set report [$this report]
-
- foreach role [lsort [$this roles]] {
- if { [llength [$this roles]] != 1 } {
- if [$report queued] { $report line }
- $report space 5
- set text "on Role $role:"
- set len [string length $text]
- $report print $text
- if {[expr $len%2] == 1} {
- $report space
- incr len
- }
- incr len 5
- $report print " ." [expr $TEXTLEN - $len] fill
- $report space 5
- }
-
- set rr [$object findRight $role]
-
- if { [$rr isNil] || ![$object hasRights] } {
- $report print $NOTSPECIFIED line
- continue
- }
-
- foreach action [$this actions] {
- switch [$rr access $action] {
- 0 - noAccess { $report print $NOACC }
- 1 - prohibited { $report print $DENYD }
- 2 - allowed { $report print $ALLOW }
- 3 - undefined { $report print $UNDEF }
- }
- }
- $report line
- }
- }
-
- method ReportSecurity::printInfo {this} {
- set report [$this report]
- set cnt 0
- $report space 4
- foreach action [$this actions] {
- set act [string range $action 0 2]
- $report print [string toupper $act] 4
- $report print ": "
- $report print $action 24
- incr cnt
- if {$cnt == 4} { set cnt 0; $report line; $report space 4 }
- }
- if {$cnt != 0} { $report line }
-
- $report space 4
- $report print "$ALLOW: Allowed" 30
- $report print "$DENYD: Denied" 30
- $report print "$UNDEF: Undefined" 30
- $report print "$NOACC: No Access" line
- $report line
- }
-
- method ReportSecurity::doReport {this v_objects} {
- upvar $v_objects objects
- if ![info exists objects] { return 0 }
- set report [$this report]
-
- $report header {
- $report print ControlledObject $TEXTLEN
- $report space 5
- foreach action [$this actions] {
- set act [string range $action 0 2]
- $report print [string toupper $act] 4
- }
- $report line
- $report line
- }
-
- $this printInfo
- foreach obj $objects {
- set text [$obj text]
- set len [string length $text]
- if { $len <= $TEXTLEN && [llength [$this roles]] == 1 } {
- $report print $text
- if {[expr $len%2] == 1} {
- $report space
- incr len
- }
- $report print " ." [expr $TEXTLEN - $len] fill
- } else {
- $report print $text $TEXTLEN
- }
- $report space 5
- $this findActions $obj [$this roles]
- }
- $report page
- }
-
- #
- # Return all objects of class 'Controlled' that are sub-objects of
- # the given object.
- #
- method ReportSecurity::controlledObjects {this obj} {
- global controlled
-
- set class [$obj ORB_class]
-
- foreach baseClass [$this baseClassesOf $class] {
- if ![info exists controlled($baseClass)] {
- continue
- }
- foreach method $controlled($baseClass) {
- foreach subObj [$obj $method] {
- set result($subObj) 1
- }
- }
- }
- if ![info exists result] {
- return {}
- }
- return [array names result]
- }
-
- #
- # Since Tcl cannot handle recursive routines well, we have to retrieve
- # the objects in a somewhat less efficient way.
- #
- method ReportSecurity::control {this obj} {
- set finished {}
- set newset {}
- set workset [$this controlledObjects $obj]
-
- while {[llength $workset] != 0} {
- set finished [concat $finished $workset]
- foreach objpart $workset {
- set result [$this controlledObjects $objpart]
- foreach element $result {
- if {[lsearch $finished $element] == -1} {
- lappend newset $element
- }
- }
- }
- set workset $newset
- set newset {}
- }
- return [osort ORB_class $finished]
- }
-
-
- #
- # Returns all names of classes that are bases of the given class.
- # The given class is included in this list.
- #
- method ReportSecurity::baseClassesOf {this class} {
- foreach base [$class info supers] {
- set bases($base) 1
-
- foreach baseBase [$this baseClassesOf $base] {
- set bases($baseBase) 1
- }
- }
- if ![info exists bases] {
- return [list $class]
- }
- return [concat [list $class] [array names bases]]
- }
-
-
- method ReportSecurity::corporateReport {this} {
- set objects [$this control [$this corporate]]
- return [$this doReport objects]
- }
-
- method ReportSecurity::projectReport {this} {
- set objects [$this control [$this project]]
- return [$this doReport objects]
- }
-
- method ReportSecurity::configReport {this} {
- set objects [$this control [$this configV]]
- return [$this doReport objects]
- }
-
- method ReportSecurity::phaseReport {this} {
- set objects [$this control [$this phaseV]]
- return [$this doReport objects]
- }
-
- method ReportSecurity::systemReport {this} {
- set objects [$this control [$this systemV]]
- return [$this doReport objects]
- }
-
- method ReportSecurity::fileReport {this} {
- set objects [$this control [$this fileV]]
- return [$this doReport objects]
- }
- # ----------------------------------------------------------------------
- set executeMe [ReportSecurity new]
-