Index: openacs-4/packages/xowiki/xowiki.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/xowiki.info,v diff -u -r1.45 -r1.46 --- openacs-4/packages/xowiki/xowiki.info 25 Feb 2007 09:57:09 -0000 1.45 +++ openacs-4/packages/xowiki/xowiki.info 9 Mar 2007 11:05:34 -0000 1.46 @@ -8,11 +8,11 @@ f xowiki - + Gustaf Neumann A more generic xotcl-based wikis example with object types and subtypes based on the content repository (with category support) - 2007-02-25 + 2007-03-09 <pre> XoWiki is a wiki implementation for OpenACS in XOTcl. Instead of trying to implement the full set of wiki markup commands of systems @@ -93,20 +93,22 @@ 0.46: support for announcement style configuration 0.47: podcast support + +0.48: policy management moved to xotcl-core, more detailed form field specification for page instances, flash support, yndication status in www/admin/list, file import/export, style information in css files </pre> BSD-Style 0 - + - + - + Index: openacs-4/packages/xowiki/tcl/package-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/package-procs.tcl,v diff -u -r1.45 -r1.46 --- openacs-4/packages/xowiki/tcl/package-procs.tcl 8 Mar 2007 12:05:32 -0000 1.45 +++ openacs-4/packages/xowiki/tcl/package-procs.tcl 9 Mar 2007 11:05:34 -0000 1.46 @@ -183,8 +183,8 @@ -party_id [::xo::cc user_id]] }] } else { # determine privilege from policy - set granted [my permission_p $object $method] - #my log "--p $id permission_p $object $method ==> $granted" + set granted [my check_permissions $object $method] + #my log "--p $id check_permissions $object $method ==> $granted" } if {$granted} { if {[$object istype ::xowiki::Package]} { @@ -339,15 +339,15 @@ Package instproc call {object method} { my instvar policy - #my log "--call check_permissions $object $method -> [$policy check_permissions $object $method]" - if {[$policy check_permissions $object $method]} { + #my log "--call enforce_permissions $object $method -> [$policy enforce_permissions $object $method]" + if {[$policy enforce_permissions $object $method]} { #my log "--p calling $object ([$object info class]) '$method'" $object $method } else { my log "not allowed to call $object $method" } } - Package instforward permission_p {%my set policy} %proc + Package instforward check_permissions {%my set policy} %proc Package instproc get_name_and_lang_from_path {path vlang vlocal_name} { my upvar $vlang lang $vlocal_name local_name @@ -783,152 +783,10 @@ #my log "--c [self args] returns $result" return $result } - - Class Policy - Policy instproc defined_methods {class} { - set c [self]::$class - expr {[my isclass $c] ? [$c array names require_permission] : [list]} - } - Policy instproc check_privilege {{-login true} privilege object method} { - set allowed -1 ;# undecided - if {[acs_user::site_wide_admin_p]} { - return 1 - } - switch $privilege { - none {return 1} - login { - if {$login} { - auth::require_login; return 1 - } else { - return [expr {[::xo::cc user_id] != 0}] - } - } - creator { - if {[$object exists creation_user]} { - if {$login} { - auth::require_login - } else { - if {[::xo::cc user_id] == 0} { - return 0 - } - } - if {[$object set creation_user] == [::xo::cc user_id]} { - set allowed 1 - } else { - set allowed [::xo::cc permission -object_id [::xo::cc package_id] -privilege admin \ - -party_id [xo::cc user_id]] - } - } else { - set allowed 0 - } - } - swa { - set allowed 0 - #if {!$allowed} { - # ad_return_warning "Insufficient Permissions" \ - # "Only side wide admins are allowed for this operation! ($object $method)" - # ad_script_abort - #} - } - } - #my log "--check_privilege {$privilege $object $method} ==> $allowed" - return $allowed - } + Class create Policy -superclass ::xo::Policy - Policy instproc get_privilege {permission object method} { - # the privilege might by primitive (one word privilege) - # or it might be complex (attribute + privilege) - # or it might be conditional (primitive or complex) in a list of privilges - - foreach p $permission { - - set condition [lindex $p 0] - if {[llength $condition]>1} { - # we have a condition - if {[eval $object condition $method $condition]} { - # the condition is true - #my log "--c check cond=$condition == TRUE" - return [my get_privilege [lrange $p 1 end] $object $method] - } - } else { - # we have no condition - return [list [expr {[llength $p] == 1 ? "primitive" : "complex"}] $p] - } - } - } - - Policy instproc permission_p {object method} { - foreach class [concat [$object info class] [[$object info class] info heritage]] { - set c [self]::[namespace tail $class] - if {![my isclass $c]} continue - set key require_permission($method) - if {[$c exists $key]} { - set permission [$c set $key] - - foreach {kind p} [my get_privilege $permission $object $method] break - switch $kind { - primitive {return [my check_privilege -login false $p $object $method]} - complex { - foreach {attribute privilege} $p break - set id [$object set $attribute] - my log "--p checking permission::permission_p -object_id $id -privilege $privilege" - return [::xo::cc permission -object_id $id -privilege $privilege \ - -party_id [xo::cc user_id]] - } - } - } - } - return 0 - } - - Policy instproc check_permissions {object method} { - #my log "--p check_permissions {$object $method}" - set allowed 0 - foreach class [concat [$object info class] [[$object info class] info heritage]] { - set c [self]::[namespace tail $class] - if {![my isclass $c]} continue - set key require_permission($method) - if {[$c exists $key]} { - set permission [$c set $key] - - foreach {kind p} [my get_privilege $permission $object $method] break - switch $kind { - primitive { - set allowed [my check_privilege $p $object $method] - set privilege $p - break - } - complex { - foreach {attribute privilege} $p break - set id [$object set $attribute] - #my log "--p checking permission::permission_p -object_id $id -privilege $privilege" - set allowed [::xo::cc permission -object_id $id -privilege $privilege \ - -party_id [xo::cc user_id]] - #permission::require_permission -object_id $id -privilege $privilege - break - } - } - } - } - - #my log "--p check_permissions {$object $method} ==> $allowed" - - if {!$allowed} { - ns_log notice "permission::require_permission: [::xo::cc user_id] doesn't \ - have $privilege on $object" - ad_return_forbidden "Permission Denied" "
- You don't have sufficient permissions for $method on this object ($object). -
" - ad_script_abort - } - - return $allowed - } - - - Policy policy1 -contains { Class Package -array set require_permission { @@ -1002,12 +860,12 @@ # Class Package -array set require_permission { - reindex {{id admin}} - rss none + reindex {{id admin}} + rss none google-sitemap none google-sitemapindex none - delete swa - edit-new {{{has_class ::xowiki::Object} swa} {id create}} + delete swa + edit-new {{{has_class ::xowiki::Object} swa} {id create}} } Class Page -array set require_permission { Index: openacs-4/packages/xowiki/tcl/xowiki-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/xowiki-procs.tcl,v diff -u -r1.83 -r1.84 --- openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 7 Mar 2007 20:12:41 -0000 1.83 +++ openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 9 Mar 2007 11:05:34 -0000 1.84 @@ -885,3 +885,4 @@ } source [file dirname [info script]]/xowiki-www-procs.tcl +