Index: openacs-4/packages/chat/tcl/chat-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/chat/tcl/chat-procs.tcl,v diff -u -N -r1.13 -r1.14 --- openacs-4/packages/chat/tcl/chat-procs.tcl 17 Jun 2016 17:36:11 -0000 1.13 +++ openacs-4/packages/chat/tcl/chat-procs.tcl 7 Aug 2017 23:48:07 -0000 1.14 @@ -7,8 +7,15 @@ @cvs-id $Id$ } -ad_proc -private chat_start_server {} { Start Java chat server. } { +# TODO: all the remaining Java stuff should fade away at some point, +# its status is unknown and we won't be allowed to have binaries into +# the core by distros. +ad_proc -private chat_start_server { +} { + Start Java chat server. +} { + if {[nsv_get chat server_started]} { return } @@ -23,7 +30,7 @@ # Wait until chat server started before spawning new threads connecting to the server. while { $done == 0} { - if [catch {set fds [ns_sockopen -nonblock $host_location $port]} errmsg] { + if {[catch {set fds [ns_sockopen -nonblock $host_location $port]} errmsg]} { set done 0 } else { set done 1 @@ -43,7 +50,12 @@ nsv_set chat server_started 1 } -ad_proc -private chat_broadcast_to_applets {host port} { Broadcast chat message from HTML client to Java server. } { +ad_proc -private chat_broadcast_to_applets { + host + port +} { + Broadcast chat message from HTML client to Java server. +} { # Chat server must already started otherwise error will occur. set fds [ns_sockopen -nonblock $host $port] @@ -70,9 +82,13 @@ } } +ad_proc -private chat_receive_from_server { + host + port +} { + Receive messages from Java clients. +} { -ad_proc -private chat_receive_from_server {host port} { Receive messages from Java clients. } { - set fds [ns_sockopen -nonblock $host $port] set r [lindex $fds 0] @@ -81,7 +97,13 @@ ns_log Notice "chat_receive_from_server: Listening for messages from applets." - puts $w "-1AOL_READERT-1" + puts $w " + + -1 + AOL_READER + T + -1 + " flush $w set running 1 @@ -93,37 +115,37 @@ foreach r $rfds { if {[ns_sockcheck $r] && [set line [string trim [gets $r]]] != ""} { - + regexp "(.*)" $line match room_id regexp "(.*)" $line match screen_name regexp "(.*)" $line match msg regexp "(.*)" $line match user_id if {![nsv_exists chat_room $room_id]} { - nsv_set chat_room $room_id {} + nsv_set chat_room $room_id {} } - ns_log Notice "YY Nachricht: $msg" ::chat::Chat c1 -volatile -chat_id $room_id -user_id $user_id -session_id 0 switch $msg { "/enter" { c1 login - set msg [_ xotcl-core.has_entered_the_room] } "/leave" { c1 logout - set msg [_ xotcl-core.has_left_the_room] } default { - c1 add_msg -uid $user_id $msg + c1 add_msg -uid $user_id $msg } } - chat_room_get -room_id $room_id -array room_info - if { $room_info(archive_p) == "t" } { - if {[catch {chat_post_message_to_db -creation_user $user_id $room_id $msg} errmsg]} { - ns_log error "chat_post_message_to_db: error: $errmsg" - } - } + chat_room_get -room_id $room_id -array room_info + if { $room_info(archive_p) == "t" } { + if {[catch { + chat_post_message_to_db \ + -creation_user $user_id $room_id $msg + } errmsg]} { + ad_log error "chat_post_message_to_db: error: $errmsg" + } + } nsv_lappend chat_room $room_id $line @@ -142,35 +164,125 @@ } { Log chat message to the database. } { - # ns_log Notice $msg - db_exec_plsql post_message {} + db_string post_message {} +} +# create a cache for the chat package +if {"chat_room_cache" ni [ns_cache_names]} { + # these should be around 1000 entries + ns_cache_create chat_room_cache 350000 } + +ad_proc -public chat_room_get { + {-room_id {}} + {-array:required} +} { + Get all the information about a chat room into an array +} { + upvar $array row + array set row [ns_cache_eval -- chat_room_cache $room_id { + chat_room_get_not_cached $room_id + }] +} + +ad_proc -private chat_room_get_not_cached { + room_id +} { + if {![db_0or1row select_room_info { + select * from chat_rooms + where room_id = :room_id + } -column_array row]} { + set msg "Cannot find data for chatroom $room_id" + ad_log error $msg + error $msg + } + acs_object::get \ + -object_id $room_id \ + -array obj + set row(creation_user) $obj(creation_user) + set row(creation_date) $obj(creation_date_ansi) + set row(creation_ip) $obj(creation_ip) + set row(modifying_user) $obj(modifying_user) + set row(last_modified) $obj(last_modified_ansi) + set row(modifying_ip) $obj(modifying_ip) + return [array get row] +} + ad_proc -public chat_room_new { {-description ""} {-moderated_p f} {-active_p t} {-archive_p f} {-auto_flush_p t} {-auto_transcript_p f} + {-login_messages_p t} + {-logout_messages_p t} + {-messages_time_window 600} {-context_id ""} {-creation_user ""} {-creation_ip ""} pretty_name - } { Create new chat room. Return room_id if successful else raise error. } { + if {[ad_conn isconnected] && $creation_user eq ""} { + set creation_user [ad_conn user_id] + } db_transaction { - set room_id [db_exec_plsql create_room {}] - } + set room_id [::xo::db::sql::acs_object new \ + -object_type "chat_room" \ + -creation_user $creation_user \ + -creation_ip $creation_ip \ + -context_id $context_id] - db_exec_plsql grant_permission {} + db_dml insert_room {} + if {$creation_user ne ""} { + foreach privilege {edit view delete} { + permission::grant \ + -party_id $creation_user \ + -object_id $room_id \ + -privilege chat_room_${privilege} + } + permission::grant \ + -party_id $creation_user \ + -object_id $room_id \ + -privilege chat_transcript_create + } + } + return $room_id } +ad_proc -public chat_room_exists_p { + room_id +} { + Return whether a chat room exists + + @return a boolean +} { + if {[ns_cache_keys -exact -- chat_room_cache $room_id] ne ""} { + # chat room is in cache: it exists "for sure" + return 1 + } elseif {[info exists ::chat_room_deleted_p($room_id)]} { + # chat room deletion has been recorded in threaded cache: as + # object id comes from a sequence, unless somebody puts an id + # by hand, the same will never be used again system wide, so + # it is safe to cache this + return 0 + } elseif {[db_0or1row room_exists { + select 1 from chat_rooms + where room_id = :room_id}]} { + # chat room existance has been confirmed by query + return 1 + } else { + # chat room is not there: take note of this in threaded cache + set ::chat_room_deleted_p($room_id) 1 + return 0 + } +} + ad_proc -public chat_room_edit { room_id pretty_name @@ -180,56 +292,61 @@ archive_p auto_flush_p auto_transcript_p + login_messages_p + logout_messages_p + messages_time_window } { Edit information on chat room. All information require. } { - db_exec_plsql edit_room {} + db_dml update_room {} + ns_cache_flush -- chat_room_cache $room_id } ad_proc -public chat_room_delete { room_id } { Delete chat room. } { - db_exec_plsql delete_room {} + db_string delete_room {} + ns_cache_flush -- chat_room_cache $room_id } ad_proc -public chat_room_message_delete { room_id } { Delete all message in the room. } { - db_exec_plsql delete_message {} + db_string delete_message {} } ad_proc -public chat_message_count { room_id } { Get message count in the room. } { - - return [db_exec_plsql message_count {}] + return [db_string message_count {} -default 0] } - - ad_proc -public room_active_status { room_id } { Get room active status. } { - - return [db_string get_active { select active_p from chat_rooms where room_id = :room_id}] - + if {[chat_room_exists_p $room_id]} { + chat_room_get -room_id $room_id -array c + return [expr {$c(active_p) ne "" ? $c(active_p) : "f"}] + } else { + return "f" + } } ad_proc -public chat_room_name { room_id } { Get chat room name. } { - return [db_string get_room_name {} -default "" ] - + chat_room_get -room_id $room_id -array c + return $c(pretty_name) } ad_proc -public chat_moderator_grant { @@ -238,7 +355,10 @@ } { Grant party a chat moderate privilege to this chat room. } { - db_exec_plsql grant_moderator {} + permission::grant \ + -party_id $party_id \ + -object_id $room_id \ + -privilege "chat_room_moderate" } ad_proc -public chat_moderator_revoke { @@ -247,9 +367,10 @@ } { Revoke party a chat moderate privilege to this chat room. } { - - db_exec_plsql revoke_moderator {} - + permission::revoke \ + -party_id $party_id \ + -object_id $room_id \ + -privilege "chat_room_moderate" } ad_proc -public chat_user_grant { @@ -259,19 +380,28 @@ Grant party a chat privilege to this chat room. } { db_transaction { - db_exec_plsql grant_user {} + foreach privilege {read write} { + permission::grant \ + -party_id $party_id \ + -object_id $room_id \ + -privilege chat_${privilege} + } } } - ad_proc -public chat_user_revoke { room_id party_id } { Revoke party a chat privilege to this chat room. } { db_transaction { - db_exec_plsql revoke_user {} + foreach privilege {read write} { + permission::revoke \ + -party_id $party_id \ + -object_id $room_id \ + -privilege chat_${privilege} + } } } @@ -281,21 +411,22 @@ } { Explicit ban user from this chat room. } { - util_memoize_flush \ - "permission::permission_p_not_cached -party_id $party_id -object_id $room_id -privilege chat_ban" - db_exec_plsql ban_user {} + permission::grant \ + -party_id $party_id \ + -object_id $room_id \ + -privilege "chat_ban" } - ad_proc -public chat_user_unban { room_id party_id } { unban user from this chat room. } { - util_memoize_flush \ - "permission::permission_p_not_cached -party_id $party_id -object_id $room_id -privilege chat_ban" - db_exec_plsql ban_user {} + permission::revoke \ + -party_id $party_id \ + -object_id $room_id \ + -privilege "chat_ban" } ad_proc -public chat_revoke_moderators { @@ -305,39 +436,30 @@ Revoke a list of parties of a moderate privilege from this room. } { foreach party_id $revoke_list { - db_dml revoke_moderate { - begin - acs_persmission.revoke_permission(:room_id, :party_id, 'chat_moderate_room'); - end - } + permission::revoke \ + -party_id $party_id \ + -object_id $room_id \ + -privilege "chat_moderate_room" } - } ad_proc -public chat_room_moderate_p { room_id } { Return the moderate status of this chat room. } { - set moderate_p [db_string get_chat_room_moderate { - select moderated_p - from chat_rooms - where room_id = :room_id - }] - - return $moderate_p - + chat_room_get -room_id $room_id -array c + return $c(moderated_p) } ad_proc -public chat_user_name { user_id } { Return display name of this user to use in chat. } { - acs_user::get -user_id $user_id -array user - set name [expr {$user(screen_name) ne "" ? $user(screen_name) : $user(name)}] + acs_user::get -user_id $user_id -array user + set name [expr {$user(screen_name) ne "" ? $user(screen_name) : $user(name)}] return $name - } ad_proc -public chat_message_post { @@ -348,41 +470,39 @@ } { Post message to the chat room and broadcast to all applet clients. Used by ajax + html. } { - if {$moderator_p == 1 } { + if {$moderator_p == 1} { set status "approved" } else { set status "pending" } - set default_client [parameter::get -parameter "DefaultClient" -default "ajax"] + set default_client [parameter::get -parameter "DefaultClient" -default "ajax"] - if {$default_client eq "java"} { - set chat_msg "[chat_user_name $user_id]$user_id$room_id$message$status" - # Add message to queue. Notify thread responsible for - # broadcast message to applets. - nsv_set chat html_message $chat_msg - ns_mutex unlock [nsv_get chat new_message] - } - - # do not write messages to the database if the room should not be archived - chat_room_get -room_id $room_id -array room_info - if { $room_info(archive_p) == "f" } { return } - - # write message to the database - if {[catch {chat_post_message_to_db -creation_user $user_id $room_id $message} errmsg]} { - ns_log error "chat_post_message_to_db: error: $errmsg" - } + # do not write messages to the database if the room should not be archived + chat_room_get -room_id $room_id -array room_info + if { $room_info(archive_p) == "f" } { return } + + # write message to the database + if {[catch {chat_post_message_to_db -creation_user $user_id $room_id $message} errmsg]} { + ns_log error "chat_post_message_to_db: error: $errmsg" + } } - ad_proc -public chat_moderate_message_post { room_id user_id message } { Post moderate message to the chat room and broadcast to all applet clients. Only use by HTML client. } { - set chat_msg "[chat_user_name $user_id]$user_id$room_id$messagepending" + set chat_msg " + + [chat_user_name $user_id] + $user_id + $room_id + $message + pending + " # Add message to queue. Notify thread responsible for broadcast message to applets. nsv_set chat html_message $chat_msg @@ -394,20 +514,21 @@ room_id user_id } { - Retrieve all messages from the chat room starting from first_msg_id. Return messages are store in multirow format. + Retrieve all messages from the chat room starting from + first_msg_id. Return messages are store in multirow format. } { - ns_log debug "chat_message_retrieve: starting message retrieve" - # The first time html client enter chat room, chat_room variable is not initialize correctly. - # Therefore I just hard code the variable. + # The first time html client enter chat room, chat_room variable + # is not initialize correctly. Therefore I just hard code the + # variable. if {![nsv_exists chat_room $room_id]} { - nsv_set chat_room $room_id [list "[chat_user_name $user_id]$room_id[_ chat.has_entered_the_room]approved"] + nsv_set chat_room $room_id {} } set user_name [chat_user_name $user_id] - upvar "$msgs:rowcount" counter + upvar "$msgs:rowcount" counter set chat_messages [nsv_get chat_room $room_id] @@ -416,16 +537,15 @@ set cnt $count set counter 0 - #foreach msg $chat_messages - for { set i [expr {$cnt - 1}] } { $i >= 0 } { set i [expr {$i - 1}] } { + #foreach msg $chat_messages + for { set i [expr {$cnt - 1}] } { $i >= 0 } { incr i -1 } { set msg [lindex $chat_messages $i] regexp "(.*)" $msg match screen_name regexp "(.*)" $msg match chat_msg regexp "(.*)" $msg match status - - if {$status eq "pending" || $status eq "rejected"} { - continue; + if {$status in {"pending" "rejected"}} { + continue } upvar "$msgs:[expr {$counter + 1}]" array_val @@ -439,10 +559,8 @@ return } } - } - ad_proc -public chat_transcript_new { {-description ""} {-context_id ""} @@ -454,25 +572,36 @@ } { Create chat transcript. } { + if {[ad_conn isconnected] && $creation_user eq ""} { + set creation_user [ad_conn user_id] + } db_transaction { - set transcript_id [db_exec_plsql create_transcript {}] - if { $transcript_id ne 0 } { - db_dml update_contents {} - db_exec_plsql grant_permission {} + set transcript_id [::xo::db::sql::acs_object new \ + -object_type "chat_transcript" \ + -creation_user $creation_user \ + -creation_ip $creation_ip \ + -context_id $context_id] + + db_dml insert_transcript {} + + foreach privilege {edit view delete} { + permission::grant \ + -party_id $creation_user \ + -object_id $transcript_id \ + -privilege chat_transcript_${privilege} } } return $transcript_id - } ad_proc -public chat_transcript_delete { transcript_id } { Delete chat transcript. } { - db_exec_plsql delete_transcript {} + db_string delete_transcript {} } ad_proc -public chat_transcript_edit { @@ -483,54 +612,43 @@ } { Edit chat transcript. } { - db_exec_plsql edit_transcript {} - db_dml update_contents {} + db_dml update_transcript {} } -ad_proc -public chat_room_get { - {-room_id {}} - {-array:required} +ad_proc -private chat_flush_rooms {} { + Flush the messages in all of the chat rooms } { - Get all the information about a chat room into an array -} { - upvar $array row - array set row [util_memoize [list chat_room_get_not_cached $room_id]] -} - -ad_proc -private chat_room_get_not_cached { - room_id -} { - db_1row select_user_info {select * from chat_rooms where room_id = :room_id} -column_array row - return [array get row] -} - -ad_proc -private chat_flush_rooms {} {Flush the messages in all of the chat rooms} { - # ns_log Notice "YY Starting chat_flush_rooms operation" - set room_ids [db_list get_rooms *SQL*] + set room_ids [db_list get_rooms *SQL*] foreach room_id $room_ids { chat_room_flush $room_id } -} +} -ad_proc -private chat_room_flush { room_id } {Flush the messages a single chat room} { - # ns_log Notice "YY flushing room $room_id" +ad_proc -private chat_room_flush { + room_id +} { + Flush the messages a single chat room +} { db_transaction { - array set room_info [chat_room_get_not_cached $room_id] - set contents "" + chat_room_get -room_id $room_id -array room_info # do we have to create a transcript for the room if { $room_info(auto_transcript_p) == "t" } { # build a list of all messages - db_foreach get_archives_messages {} { - append contents "\[$creation_date\] [chat_user_name $creation_user]: $msg
\n" + set contents [list] + foreach message [db_list_of_lists get_archives_messages {}] { + lassign $message msg creation_user creation_date + set user_name [expr {$creation_user > 0 ? [chat_user_name $creation_user] : "system"}] + lappend contents "\[$creation_date\] ${user_name}: $msg" } if { $contents ne "" } { + set today [clock format [clock seconds] -format "%d.%m.%Y"] chat_transcript_new \ -description "#chat.automatically_created_transcript#" \ - "#chat.transcript_of_date# [clock format [clock seconds] -format "%d.%m.%Y"]" $contents $room_id + "#chat.transcript_of_date# $today" \ + [join $contents "
\n"] $room_id } } # clear all the messages in the room chat_room_message_delete $room_id } } -