nsf

Clone
Gustaf A. Neumann <neumann@Gustaf-A-Neumanns-iMac.local>
committed
9248d25
on 04 May 11
- nx-mango.tcl: * support for unique indices * support for query operators "in" and "all"
2-1-0-rc + 65 more
openacs-4/.../xowiki/tcl/chat-procs.tcl (+102 -13)
25 25       }
26 26
27 27   Chat instproc init {} {
28 28     # :log "-- "
29 29
30 30     #
31 31     # Work through the list of provided message_relays and select a
32 32     # usable one.
33 33     #
34 34     set :mr ::xo::mr::none
35 35     foreach mr ${:message_relay} {
36 36       if {[::xo::mr::$mr can_be_used]} {
37 37         set :mr ::xo::mr::$mr
38 38         break
39 39       }
40 40     }
41 41
42 42     set :now [clock clicks -milliseconds]
43 43     if {![info exists :user_id]} {
44 44       set :user_id [ad_conn user_id]
  45       set :requestor [::xo::cc requestor]
  46       if {${:user_id} == 0} {
  47         #
  48         # Maybe the user_id was timed out, so fall potentially back to
  49         # the untrusted_user_id (which might be as well 0).
  50         #
  51         set :user_id [::xo::cc get_user_id]
45 52       }
  53       #
  54       # Keep always the original user_id
  55       #
  56       set :original_user_id ${:user_id}
  57       if {${:user_id} == 0} {
  58         #
  59         # Overwrite the user_id with the requestor. This increases
  60         # backward compatibility and eases handling of the identifier
  61         # for the user.
  62         #
  63         set :user_id ${:requestor}
  64       }
  65     }
46 66     if {![info exists :session_id]} {
47 67       set :session_id [ad_conn session_id]
48 68     }
49 69     set cls [:info class]
50 70     set :array $cls-${:chat_id}
51 71
52 72     #
53 73     # The basic nsv (typically ::chat::Chat) is hit quite frequently
54 74     # on busy sites. So reduce these these hits.
55 75
56 76     # Something to consider: We could/should do this actually in an
57 77     # init-script. The only advantage by this construct is to start
58 78     # the scheduled proc only when a chat is started.
59 79     #
60 80     acs::per_thread_cache eval -key chat-initialized-$cls {
61 81       if {![nsv_exists $cls initialized]} {
62 82         :log "-- initialize $cls"
63 83         $cls initialize_nsvs
64 84         ::acs::clusterwide nsv_set $cls initialized \
65 85             [ad_schedule_proc \
 
249 269       # ns_log notice "getting colors of [:info class] = [info exists colors]"
250 270       set color [lindex $colors [expr { [nsv_get ${:array}-color idx] % [llength $colors] }]]
251 271       ::acs::clusterwide nsv_set ${:array}-color ${:user_id} $color
252 272       ::acs::clusterwide nsv_incr ${:array}-color idx
253 273     }
254 274   }
255 275
256 276   Chat instproc get_users {} {
257 277     return [:json_encode_msg [Message new -volatile -type "users" -time [clock seconds]]]
258 278   }
259 279
260 280   Chat instproc user_active {user_id} {
261 281     # was the user already active?
262 282     #:log "--chat login already active? [nsv_exists ${:array}-last-activity $user_id]"
263 283     return [nsv_exists ${:array}-last-activity $user_id]
264 284   }
265 285
266 286   Chat instproc login {} {
267 287     :log "--chat login mode=${:mode}"
268 288     if {${:login_messages_p} && ![:user_active ${:user_id}]} {
  289       if {![nsv_array exists ${:array}-anonymous_ids]} {
  290         #
  291         # Create array in case it does not exist, since we need it in
  292         # the next command.
  293         #
  294         ::acs::clusterwide nsv_set ${:array}-anonymous_ids . .
  295       }
269 296       :add_msg -uid ${:user_id} -get_new false [_ xotcl-core.has_entered_the_room]
270 297     } elseif {${:user_id} > 0 && ![nsv_exists ${:array}-login ${:user_id}]} {
271 298       # give some proof of our presence to the chat system when we
272 299       # don't issue the login message
273 300       ::acs::clusterwide nsv_set ${:array}-login ${:user_id} [clock seconds]
274 301       ::acs::clusterwide nsv_set ${:array}-last-activity ${:user_id} ${:now}
275 302     }
276 303     :encoder noencode
277 304     #:log "--chat setting session_id ${:session_id}: ${:now} mode=${:mode}"
278 305     return [:get_all]
279 306   }
280 307
281 308   Chat instproc user_color { user_id } {
282 309     if { ![:nsv_get ${:array}-color $user_id color] } {
283 310       :log "warning: Cannot find user color for chat (${:array}-color $user_id)!"
284 311       set color [lindex [[:info class] set colors] 0]
285 312     }
286 313     return $color
287 314   }
288 315
  316   Chat instproc usable_screen_name { screen_name requestor } {
  317     if {[nsv_get ${:array}-anonymous_ids $screen_name seenRequestor]} {
  318       if {$seenRequestor eq $requestor} {
  319         #
  320         # We have this screen name already assigned to this requestor.
  321         #
  322         #ns_log notice "check screen name for $requestor in ${:array}-anonymous_ids -> later time"
  323         return 1
  324       } else {
  325         #ns_log notice "check screen name for $requestor in ${:array}-anonymous_ids -> not usable <$seenRequestor != $requestor>"
  326         return 0
  327       }
  328     }
  329     #
  330     # We saw this screen name the first time.
  331     #
  332     #ns_log notice "check screen name for $requestor in ${:array}-anonymous_ids -> first time"
  333     nsv_set ${:array}-anonymous_ids $screen_name $requestor
  334     return 1
  335   }
  336
289 337   Chat instproc user_name { user_id } {
290       if {$user_id > 0} {
  338     #
  339     # Map the provided user_id (which might be numeric or an IP
  340     # address) to a screen name, which might be the configured screen
  341     # name, the user name, or of the form userXXX.
  342     #
  343     #:log "user_name for $user_id"
  344     if {![nsf::is int32 $user_id]} {
  345       #
  346       # The user_id is a requestor (e.g. IPv4 or IPv6 address)
  347       #
  348       set requestor $user_id
  349       if {[::acs::icanuse "ns_hash"]} {
  350         set hash [ns_hash $requestor]
  351         set screen_name user[expr {$hash % 1000}]
  352         if {![:usable_screen_name $screen_name $requestor]} {
  353           #
  354           # Collision: we have this screen_name already for a
  355           # different requestor.
  356           #
  357           for {set i 1} {$i < 200} {incr i} {
  358             set screen_name user[expr {$hash % 1000}]$i
  359             if {[:usable_screen_name $screen_name $requestor]} {
  360               break
  361             }
  362           }
  363         }
  364       } else {
  365         set screen_name $requestor
  366       }
  367     } elseif {$user_id > 0} {
  368       #
  369       # True user_id
  370       #
291 371       set screen_name [acs_user::get_user_info -user_id $user_id -element screen_name]
292 372       if {$screen_name eq ""} {
293 373         set screen_name [person::name -person_id $user_id]
294 374       }
295 375     } elseif { $user_id == 0 } {
296 376       set screen_name "Nobody"
297 377     } else {
  378       #
  379       # This might be triggered during background processing.
  380       #
298 381       set screen_name "System"
299 382     }
  383     #:log "user_name for $user_id -> $screen_name"
300 384     return $screen_name
301 385   }
302 386
303 387   Chat instproc urlencode   {string} {ns_urlencode $string}
304 388   Chat instproc noencode    {string} {set string}
305 389   Chat instproc encode      {string} {my [:encoder] $string}
306 390   Chat instproc json_encode {string} {
307 391     string map [list \n \\n \" \\\" ' {\\'} \\ \\\\] $string
308 392   }
309 393
310 394   Chat instproc json_encode_msg {msg} {
311 395     set type [$msg type]
312 396     switch $type {
313 397       "message" {
314 398         set message   [$msg msg]
315 399         set user_id   [$msg user_id]
316 400         set user      [:user_name $user_id]
317 401         set color     [$msg color]
318 402         set timestamp [clock format [$msg time] -format {[%H:%M:%S]}]
319 403         foreach var {message user timestamp color user_id} {
 
327 411           if {$user_id < 0} continue
328 412           set timestamp [clock format [expr {[clock seconds] - $timestamp}] -format "%H:%M:%S" -gmt 1]
329 413           set user      [:user_name $user_id]
330 414           set color     [:user_color $user_id]
331 415           foreach var {user timestamp color user_id} {
332 416             set $var [:json_encode [set $var]]
333 417           }
334 418           lappend message [subst {{"timestamp": "$timestamp", "user": "$user", "color": "$color", "user_id": "$user_id"}}]
335 419         }
336 420         set message "\[[join $message ,]\]"
337 421         return [subst {{"type": "$type", "chat_id": "${:chat_id}", "message": $message}\n}]
338 422       }
339 423     }
340 424   }
341 425
342 426   Chat instproc js_encode_msg {msg} {
343 427     set json [string trim [:json_encode_msg $msg]]
344 428     if {$json ne ""} {
345 429       return [subst {
346 430         <script nonce='[security::csp::nonce]'>
347              var data = $json;
  431            let data = $json;
348 432            parent.getData(data);
349 433         </script>\n
350 434       }]
351 435     } else {
352 436       return
353 437     }
354 438   }
355 439
356 440   Chat instproc broadcast_msg {msg} {
357 441     #:log "--chat broadcast_msg"
358 442     ${:mr} send_to_subscriber chat-${:chat_id} [:json_encode_msg $msg]
359 443   }
360 444
361 445   Chat instproc subscribe {-uid} {
362 446     set user_id [expr {[info exists uid] ? $uid : ${:user_id}}]
363 447     set color [:user_color $user_id]
364 448     #ns_log notice "--CHAT [self] subscribe chat-${:chat_id} -mode ${:mode} via <${:mr}>"
365 449     ${:mr} subscribe chat-${:chat_id} -mode ${:mode}
366 450   }
367 451
 
455 539       if {![regexp msie|opera [string tolower [ns_set iget [ns_conn headers] User-Agent]]]} {
456 540         #
457 541         # Explorer doesn't expose partial response until request state
458 542         # != 4, while Opera fires onreadystateevent only once. For
459 543         # this reason, for every browser except them, we could use the
460 544         # nice mode without the spinning load indicator.
461 545         #
462 546         set mode streaming
463 547       }
464 548     }
465 549
466 550     return $mode
467 551   }
468 552
469 553   ::xo::ChatClass ad_instproc login {
470 554     -chat_id:required
471 555     {-skin "classic"}
472 556     {-package_id ""}
473 557     {-mode ""}
474 558     {-path ""}
475       {-avatar_p true}
476       -login_messages_p
477       -logout_messages_p
  559     {-avatar_p:boolean true}
  560     {-force_login_p:boolean false}
  561     -login_messages_p:boolean
  562     -logout_messages_p:boolean
478 563     -timewindow
479 564   } {
480 565     Logs into a chat
481 566   } {
482 567     #:log "--chat"
483       if {![ns_conn isconnected]} return
  568     if {![ns_conn isconnected]} {
  569       return
  570     }
  571     if {$force_login_p} {
484 572       auth::require_login
  573     }
485 574
486 575     set session_id [ad_conn session_id].[clock seconds]
487 576     set base_url [export_vars -base /shared/ajax/chat -no_empty {
488 577       {id $chat_id} {s $session_id} {class "[self]"}
489 578     }]
490 579
491 580     # This might come in handy to get resources from the chat package
492 581     # if we want to have e.g. a separate css.
493 582     # set package_key [apm_package_key_from_id $package_id]
494 583     # set resources_path /resources/${package_key}
495 584     template::head::add_css -href /resources/xowiki/chat-skins/chat-$skin.css
496 585
497 586     if {$mode eq ""} {
498 587       #
499 588       # The parameter "mode" was not specified, we try to guess the
500 589       # "best" mode known to work for the currently used browser.
501 590       #
502 591       set mode [:get_mode]
503 592       :log "--chat mode $mode"
504 593     }
 
529 618     # Should we add a full screen link to the chat?
530 619     set fs_link_p true
531 620
532 621     # Should we display avatars? (JavaScript can only take 'true' or 'false' as boolean values)
533 622     if {$avatar_p} {
534 623         set show_avatar true
535 624     } else {
536 625         set show_avatar false
537 626     }
538 627
539 628     # small JavaScript library to obtain a portable ajax request object
540 629     template::head::add_javascript -src urn:ad:js:get-http-object -order 10
541 630     template::head::add_javascript -script "const linkRegex = \"${link_regex}\";" -order 19
542 631     template::head::add_javascript -script "const show_avatar = $show_avatar;" -order 20
543 632     template::head::add_javascript -src /resources/xowiki/chat-common.js -order 21
544 633     template::head::add_javascript -src /resources/xowiki/chat-skins/chat-$skin.js -order 22
545 634     template::head::add_javascript -src $jspath -order 30
546 635
547 636     set send_url ${base_url}&m=add_msg&msg=
548 637
549       :log "--CHAT mode=$mode"
  638     #:log "--CHAT mode=$mode"
550 639
551 640     template::add_body_script -script {
552 641       document.getElementById('xowiki-chat-send').focus();
553 642     }
554 643
555 644     set html ""
556 645
557 646     if {[apm_package_installed_p chat]} {
558 647       set message_label [_ chat.message]
559 648       set send_label [_ chat.Send_Refresh]
560 649     } else {
561 650       set message_label "Message"
562 651       set send_label "Send"
563 652     }
564 653
565 654     # TODO: it is currently not possible to embed multiple chats in
566 655     # the same page.
567 656     append html [subst {
568 657       <div id='xowiki-chat'>
569 658          <div id='xowiki-chat-messages-and-form'>
570 659            <div id='xowiki-chat-messages'></div>
571 660            <div id='xowiki-chat-messages-form-block'>
572 661              <form id='xowiki-chat-messages-form' action='#'>
573 662                <input type='text' placeholder="$message_label" name='msg' id='xowiki-chat-send' autocomplete="off" />
574 663                <button id='xowiki-chat-send-button' type='submit'>$send_label</button>
575 664              </form>
576 665            </div>
577 666          </div>
578 667          <div id='xowiki-chat-users'></div>
579 668       </div>
580 669       <span id="xowiki-my-user-id" hidden>[ad_conn user_id]</span>
581 670     }]
582 671
583 672     set conf [dict create]
584       foreach var [list login_messages_p logout_messages_p timewindow] {
  673     foreach var {force_login_p login_messages_p logout_messages_p timewindow} {
585 674       if {[info exists $var]} {
586 675         dict set conf $var [set $var]
587 676       }
588 677     }
589 678
590 679     :create c1 \
591 680         -destroy_on_cleanup \
592 681         -chat_id    $chat_id \
593 682         -session_id $session_id \
594 683         -mode       $mode \
595 684         -conf       $conf
596 685     #:log "--CHAT created c1 with mode=$mode"
597 686
598 687     set js ""
599 688     set data [c1 login]
600 689     if {$data ne ""} {
601         append js [subst {
602           var data = $data;
  690       append js [subst -nocommands {
  691         let data = $data;
603 692         for (var i = 0; i < data.length; i++) {
604             renderData(data\[i\]);
  693           renderData(data[i]);
605 694         }
606 695       }]
607 696     }
608 697
609 698     if {$fs_link_p} {
610 699       append js {addFullScreenLink();}
611 700     }
612 701
613 702     append js {addSendPic();}
614 703
615 704     #:log "--CHAT create HTML for mode=$mode"
616 705
617 706     switch -- $mode {
618 707       "polling" {
619 708         append js [subst {
620 709           chatSubscribe('$subscribe_url');
621 710         }]
622 711         set send_msg_handler pollingSendMsgHandler
623 712       }
624 713