Index: openacs-4/packages/chat/tcl/chat-ajax-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/chat/tcl/chat-ajax-procs.tcl,v
diff -u -r1.32 -r1.33
--- openacs-4/packages/chat/tcl/chat-ajax-procs.tcl 18 Jan 2019 16:39:36 -0000 1.32
+++ openacs-4/packages/chat/tcl/chat-ajax-procs.tcl 3 Sep 2024 15:37:36 -0000 1.33
@@ -16,43 +16,50 @@
{-chat_id}
{-mode:optional ""}
{-path:optional ""}
+ {-skin:optional ""}
}}
+ } -ad_doc {
+ Include a chat room
+
+ @param chat_id
+ @param mode
+ @param path
+ @param skin
}
+
chat_room instproc render {} {
:get_parameters
- set html [subst {
-
- [::chat::Chat login \
+ return [::chat::Chat login \
-chat_id $chat_id \
-mode $mode \
- -path $path]
-
- }]
+ -path $path \
+ -skin $skin]
}
}
namespace eval ::chat {
::xo::ChatClass Chat -superclass ::xowiki::Chat
- Chat proc login {-chat_id {-package_id ""} {-mode ""} {-path ""}} {
- if {![chat_room_exists_p $chat_id]} {
+ Chat proc login {-chat_id {-package_id ""} {-mode ""} {-path ""} {-skin ""}} {
+ if {![::xo::db::Class exists_in_db -id $chat_id]} {
return [_ chat.Room_not_found]
} else {
- chat_room_get -room_id $chat_id -array c
- set package_id $c(context_id)
- set chat_skin [parameter::get -package_id $package_id -parameter ChatSkin]
- set chat_avatar_p [parameter::get -package_id $package_id -parameter ShowAvatarP]
- next -chat_id $chat_id \
- -skin $chat_skin \
- -show_avatar $chat_avatar_p \
- -package_id $package_id \
- -mode $mode \
- -path $path \
- -logout_messages_p $c(logout_messages_p) \
- -login_messages_p $c(login_messages_p) \
- -timewindow $c(messages_time_window)
+ set r [::xo::db::Class get_instance_from_db -id $chat_id]
+ set package_id [$r set package_id]
+ if {$skin eq ""} {
+ set skin [parameter::get -package_id $package_id -parameter ChatSkin]
+ }
+ next -chat_id $chat_id \
+ -skin $skin \
+ -package_id $package_id \
+ -mode $mode \
+ -path $path \
+ -logout_messages_p [$r set logout_messages_p] \
+ -login_messages_p [$r set login_messages_p] \
+ -timewindow [$r set messages_time_window] \
+ -avatar_p [$r set avatar_p]
}
}
@@ -64,23 +71,29 @@
select room_id, to_char(max(creation_date),'HH24:MI:SS YYYY-MM-DD') as last_activity
from chat_msgs group by room_id
} {
- ::xo::clusterwide nsv_set [self]-$room_id-seen last [clock scan $last_activity]
+ ::acs::clusterwide nsv_set [self]-$room_id-seen last [clock scan $last_activity]
}
}
Chat instproc init {} {
- set ban_p [permission::permission_p -object_id ${:chat_id} -privilege "chat_ban"]
- if {$ban_p} {
- ad_return_forbidden
- ad_script_abort
+ # Instantiating a chat outside a connection context happens
+ # e.g. in the sweeper. We don't want to check permissions in
+ # this case.
+ if {[ns_conn isconnected]} {
+ # Check that user can read the chat and is not banned
+ if {![permission::permission_p -object_id ${:chat_id} -privilege "chat_read"] ||
+ [permission::permission_p -object_id ${:chat_id} -privilege "chat_ban"]} {
+ ad_return_forbidden
+ ad_script_abort
+ }
}
next
}
# if chat doesn't exist anymore, send a message that will inform
# the user of being looking at an invalid chat
Chat instproc check_valid_room {} {
- if {![chat_room_exists_p [:chat_id]]} {
+ if {![::xo::db::Class exists_in_db -id [:chat_id]]} {
ns_return 500 text/plain "chat-errmsg: [_ chat.Room_not_found]"
ad_script_abort
}
@@ -96,21 +109,62 @@
{-uid ""}
msg
} {
- if {![chat_room_exists_p ${:chat_id}]} {
+ if {![::xo::db::Class exists_in_db -id ${:chat_id}]} {
return
}
+ set uid [expr {$uid ne "" ? $uid : ${:user_id}}]
+
+ #
+ # Check write permissions for the chat user
+ #
+ if {[string is integer -strict $uid]} {
+ #
+ # The uid is an integer, that we expect to correspond to a
+ # party_id.
+ #
+ set party_id $uid
+ } else {
+ #
+ # The uid is another kind of anonymous identifier
+ # (e.g. the IP address). We map these to the public.
+ #
+ set party_id [acs_magic_object the_public]
+ }
+ permission::require_permission \
+ -party_id $party_id \
+ -object_id ${:chat_id} \
+ -privilege "chat_write"
+
+ set r [::xo::db::Class get_instance_from_db -id ${:chat_id}]
+
# ignore empty messages
if {$msg eq ""} return
# code around expects the return value of the original method
set retval [next]
- # This way messages can be persisted immediately every time a
- # message is sent
+ #
+ # Persist the chat message. We take note of the creation user,
+ # which may be The Public for anonymous participants and the
+ # IP address.
+ #
if {[:current_message_valid]} {
- set uid [expr {$uid ne "" ? $uid : ${:user_id}}]
- chat_message_post ${:chat_id} $uid $msg 1
+ #
+ # We may also add a message from outside of a connection,
+ # for instance when the chat sweeper logs people out after
+ # the timeout.
+ #
+ if {[ns_conn isconnected]} {
+ set creation_ip [ns_conn peeraddr]
+ } else {
+ set creation_ip ""
+ }
+
+ $r post_message \
+ -msg $msg \
+ -creation_user $party_id \
+ -creation_ip $creation_ip
}
return $retval