Index: openacs-4/packages/acs-admin/tcl/acs-admin-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/tcl/acs-admin-procs.tcl,v
diff -u -r1.2.2.8 -r1.2.2.9
--- openacs-4/packages/acs-admin/tcl/acs-admin-procs.tcl 25 Feb 2024 16:13:41 -0000 1.2.2.8
+++ openacs-4/packages/acs-admin/tcl/acs-admin-procs.tcl 7 Aug 2024 15:39:19 -0000 1.2.2.9
@@ -8,6 +8,57 @@
namespace eval acs_admin {
+ ad_proc -private ::acs_admin::posture_status {
+ {-current_location:required}
+ {-url:required}
+ } {
+
+ return information about the posture status of the provided
+ URL.
+
+ @return dict containing status, diagnosis, and package_id
+ } {
+ try {
+ set node_id [site_node::get_node_id -url $url]
+ set package_id [site_node::get_object_id -node_id $node_id]
+ set parties [permission::get_parties_with_permission -object_id $package_id]
+ set direct_permissions [::acs::dc list get {select grantee_id || ' ' || privilege from acs_permissions where object_id = :package_id}]
+ #ns_log notice "direct_permissions $direct_permissions"
+ set direct_permissions [lmap p $direct_permissions {
+ #ns_log notice "XXX [lindex $p 0] [ad_decode [lindex $p 0] -1 public -2 registered-users]"
+ list [ad_decode [lindex $p 0] -1 public -2 "registered-users" [lindex $p 0]] [lindex $p 1]
+ }]
+ ns_http run -timeout 300ms $current_location$url
+ } on ok {result} {
+ set status [dict get $result status]
+ set diagnosis ""
+ switch $status {
+ 200 {set diagnosis "publicly accessible"}
+ 302 {
+ set location [ns_set iget [dict get $result headers] location]
+ if {[string match *register* $location]} {
+ set diagnosis "requires login"
+ } else {
+ set diagnosis "redirect to $location"
+ }
+ #set diagnose "publicly accessible"
+ }
+ 422 {set diagnosis "Potentially success with other parameters"}
+ 404 {set diagnosis "not installed"}
+ }
+ #append diagnosis " $node_id $package_id ($parties) // [llength $parties] // $direct_permissions"
+ #append report "status $status $diagnose\n
"
+ } on error {errorMsg} {
+ set diagnosis $errorMsg
+ set status 0
+ set direct_permissions ""
+ set parties ""
+ set package_id 0
+ }
+ return [list status $status diagnosis $diagnosis package_id $package_id direct_permissions $direct_permissions parties $parties]
+ }
+
+
ad_proc -private ::acs_admin::check_expired_certificates {
{-api production}
{-key_type ecdsa}
Index: openacs-4/packages/acs-admin/www/posture-overview.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/posture-overview.tcl,v
diff -u -r1.1.2.5 -r1.1.2.6
--- openacs-4/packages/acs-admin/www/posture-overview.tcl 7 Aug 2024 13:50:29 -0000 1.1.2.5
+++ openacs-4/packages/acs-admin/www/posture-overview.tcl 7 Aug 2024 15:39:19 -0000 1.1.2.6
@@ -188,50 +188,20 @@
personal /shared/portrait?user_id=[ad_conn user_id]
personal /shared/whos-online
}] {
- #append report "Result for $url:\n"
- try {
- set node_id [site_node::get_node_id -url $url]
- set package_id [site_node::get_object_id -node_id $node_id]
- set parties [permission::get_parties_with_permission -object_id $package_id]
- set direct_permissions [::acs::dc list get {select grantee_id || ' ' || privilege from acs_permissions where object_id = :package_id}]
- #ns_log notice "direct_permissions $direct_permissions"
- set direct_permissions [lmap p $direct_permissions {
- #ns_log notice "XXX [lindex $p 0] [ad_decode [lindex $p 0] -1 public -2 registered-users]"
- list [ad_decode [lindex $p 0] -1 public -2 "registered-users" [lindex $p 0]] [lindex $p 1]
- }]
- ns_http run -timeout 300ms $current_location$url
- } on ok {result} {
- set status [dict get $result status]
- set diagnosis ""
- switch $status {
- 200 {set diagnosis "publicly accessible"}
- 302 {
- set location [ns_set iget [dict get $result headers] location]
- if {[string match *register* $location]} {
- set diagnosis "requires login"
- } else {
- set diagnosis "redirect to $location"
- }
- #set diagnose "publicly accessible"
- }
- 422 {set diagnosis "Potentially success with other parameters"}
- 404 {set diagnosis "not installed"}
- }
- #append diagnosis " $node_id $package_id ($parties) // [llength $parties] // $direct_permissions"
- #append report "status $status $diagnose\n
"
- } on error {errorMsg} {
- set diagnosis $errorMsg
- set status 0
+
+ set posture [::acs_admin::posture_status \
+ -current_location $current_location \
+ -url $url]
+ dict with posture {
+ template::multirow append link_check \
+ $type \
+ $url \
+ $status \
+ $package_id \
+ [expr {$status == 404 ? "" : "$direct_permissions [llength $parties] parties"} ] \
+ $diagnosis
}
- template::multirow append link_check \
- $type \
- $url \
- $status \
- $package_id \
- [expr {$status == 404 ? "" : "$direct_permissions [llength $parties] parties"} ] \
- $diagnosis
-
}
template::multirow create machine_readable url status diagnosis detailURL detailLabel
@@ -270,7 +240,7 @@
set status 0
}
- template::multirow append machine_readable $url $status $diagnosis $detailURL $detailLabel
+ template::multirow append machine_readable $url $status $diagnosis $detailURL $detailLabel
}
Index: openacs-4/packages/acs-admin/www/widely-accessible-packages.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/widely-accessible-packages.adp,v
diff -u -r1.1.2.1 -r1.1.2.2
--- openacs-4/packages/acs-admin/www/widely-accessible-packages.adp 6 Aug 2024 13:41:57 -0000 1.1.2.1
+++ openacs-4/packages/acs-admin/www/widely-accessible-packages.adp 7 Aug 2024 15:39:19 -0000 1.1.2.2
@@ -19,19 +19,27 @@