Index: openacs-4/packages/general-comments/tcl/general-comments-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/general-comments/tcl/general-comments-procs.tcl,v
diff -u -r1.28 -r1.29
--- openacs-4/packages/general-comments/tcl/general-comments-procs.tcl 28 Jun 2018 10:39:36 -0000 1.28
+++ openacs-4/packages/general-comments/tcl/general-comments-procs.tcl 3 Sep 2024 15:37:39 -0000 1.29
@@ -1,9 +1,9 @@
# /packages/general-comments/tcl/general-comments-procs.tcl
-# Porting: Moved most queries from variables to in-line
-# for the QueryExtractor, appended '_deprecated' to
-# query-names in 'ad_proc -deprecated' functions.
-# Left one duplicate with 100% identical SQL (pascal)
+# Porting: Moved most queries from variables to in-line
+# for the QueryExtractor, appended '_deprecated' to
+# query-names in 'ad_proc -deprecated' functions.
+# Left one duplicate with 100% identical SQL (pascal)
ad_library {
Utility procs for general-comments
@@ -16,7 +16,7 @@
}
-ad_proc general_comment_new {
+ad_proc general_comments_new {
-object_id:required
-comment_id:required
-title:required
@@ -29,28 +29,27 @@
-content:required
} {
Creates a comment and attaches it to a given object ID
-
- @return
-
- @error
+
+ @return
+
+ @error
} {
# Generate a unique id for the message
- # result from proc comes enveloped in <>
- set rfc822_id [string range [acs_mail_lite::generate_message_id] 1 end-1]
-
+ set rfc822_id [ns_uuid]
+
db_transaction {
-
+
db_exec_plsql insert_comment {}
db_dml add_entry {}
set revision_id [content::item::get_latest_revision \
-item_id $comment_id]
db_dml set_content {} -blobs [list $content]
- # Grant the user sufficient permissions to
+ # Grant the user sufficient permissions to
# created comment. This is done here to ensure that
# a fail on permissions granting will not leave
- # the comment with incorrect permissions.
+ # the comment with incorrect permissions.
if {$user_id ne ""} {
permission::grant -object_id $comment_id \
-party_id $user_id \
@@ -62,11 +61,11 @@
}
}
+
# Convert the comment to HTML
-
if {$comment_mime_type ne "text/html"} {
- set content [ad_convert_to_html $content]
- }
+ set content [ad_html_text_convert $content]
+ }
# Start notifications
callback general_comments::notify_objects \
@@ -78,20 +77,36 @@
return $revision_id
}
+ad_proc -public general_comments_delete_messages {
+ -package_id:required
+} {
+ Deletes all comments belonging to specified package.
+} {
+ foreach comment_id [db_list get_comments {
+ select comment_id
+ from general_comments c,
+ acs_objects o
+ where c.comment_id = o.object_id
+ and o.package_id = :package_id
+ }] {
+ content::item::delete -item_id $comment_id
+ }
+}
+
ad_proc -public general_comments_get_comments {
- { -print_content_p 0 }
- { -print_attachments_p 0 }
- { -print_user_info_p 1}
- { -context_id "" }
- { -my_comments_only_p 0 }
- object_id
+ { -print_content_p:integer 0 }
+ { -print_attachments_p:integer 0 }
+ { -print_user_info_p:integer 1}
+ { -context_id:integer,0..1 "" }
+ { -my_comments_only_p:integer 0 }
+ object_id
{return_url {}}
} {
Generates a line item list of comments for the object_id.
@param print_content_p Pass in 1 to print out content of comments.
- @param print_attachments_p Pass in 1 to print out attachments of comments,
- only works if print_content_p is 1.
+ @param print_attachments_p Pass in 1 to print out attachments of comments,
+ only works if print_content_p is 1.
@param context_id Show only comments with given context_id
@param object_id The object_id to retrieve the comments for.
@param return_url A url for the user to return to after viewing a comment.
@@ -135,20 +150,20 @@
o.creation_user,
o.creation_user as author,
o.creation_date,
- case when :print_content_p
+ case when :print_content_p = 1
then r.content
- else '' end as content,
+ else [expr {[db_driverkey ""] eq "oracle" ? "empty_blob()" : "''"}] end as content,
ar.title as attachment_title,
ar.mime_type as attachment_mime_type,
coalesce(ae.label, ai.name) as attachment_name,
ai.item_id as attachment_item_id,
- exists (select 1 from images
- where image_id = ai.item_id) as image_p,
+ case when exists (select 1 from images
+ where image_id = ai.item_id) then 't' else 'f' end as image_p,
ae.url as attachment_url
from cr_revisions r,
acs_objects o
- left join cr_items ai on (:print_content_p and
- :print_attachments_p and
+ left join cr_items ai on (:print_content_p = 1 and
+ :print_attachments_p = 1 and
o.object_id = ai.parent_id)
left join cr_revisions ar on ai.live_revision = ar.revision_id
left join cr_extlinks ae on ai.item_id = ae.extlink_id
@@ -173,7 +188,7 @@
set author_url [export_vars -base /shared/community-member {{user_id $creation_user}}]
set view_url [export_vars -base ${package_url}view-comment {comment_id return_url}]
-
+
if {$image_p} {
set attachment_url [export_vars -base ${package_url}view-image {{image_id $attachment_item_id} return_url}]
} elseif {$attachment_url eq ""} {
@@ -185,7 +200,7 @@
set template [template::themed_template $template]
set code [template::adp_compile -file $template]
set html [template::adp_eval code]
-
+
return $html
}
@@ -196,7 +211,7 @@
{ -category {} }
{ -link_attributes "" }
object_id
- {return_url {}}
+ {return_url {}}
} {
Generates an html link to add a comment to an object.
@@ -220,7 +235,7 @@
if { ![info exists object_name] } { set object_name [acs_object_name $object_id] }
if { ![info exists context_id] } { set context_id $object_id }
- set html [subst {$link_text}]
return $html
@@ -233,6 +248,44 @@
return [site_node::get_package_url -package_key "general-comments"]
}
+#
+# Package-specific page contract filter
+#
+
+ad_page_contract_filter general_comments_safe { name value } {
+ Safety checks for content posted in a comment. These checks are
+ package-specific, because content we may allow in other packages,
+ e.g. via the AllowedTag parameter in acs-kernel, should not be
+ allowed here.
+} {
+ #
+ # We do not allow iframes or frames
+ #
+ if {[regexp -nocase {<(iframe|frame)} $value]} {
+ ad_complain [_ acs-tcl.lt_name_contains_invalid]
+ return 0
+ }
+
+ #
+ # We do not allow any javascript in the content, including
+ # event handlers.
+ #
+ if {![ad_dom_sanitize_html \
+ -allowed_tags * \
+ -allowed_attributes * \
+ -allowed_protocols * \
+ -html $value \
+ -no_js \
+ -validate]} {
+ ad_complain [_ acs-tcl.lt_name_contains_invalid]
+ return 0
+ }
+
+ return 1
+}
+
+##
+
# these are being replaced with the above procs
namespace eval general_comments {
@@ -241,7 +294,7 @@
@param object_id The object_id to retrieve the comments for.
@param return_url A url for the user to return to after viewing a comment.
-
+
@see general_comments_get_comments
} {
@@ -289,7 +342,7 @@
# get the package url
set package_url [general_comments_package_url]
- set html [subst {$link_text
}]
return $html