1# $Id$ 2 3package require msgcat 4 5namespace eval ejabberd { 6 ::msgcat::mcload [file join [file dirname [info script]] msgs] 7 8 if {![::plugins::is_registered ejabberd]} { 9 ::plugins::register ejabberd \ 10 -namespace [namespace current] \ 11 -source [info script] \ 12 -description [::msgcat::mc "Whether the Ejabberd plugin is loaded."] \ 13 -loadcommand [namespace code load] \ 14 -unloadcommand [namespace code unload] 15 return 16 } 17 18 custom::defvar ejabberd_server_list {} \ 19 [::msgcat::mc "List of ejabberd servers."] \ 20 -group Hidden 21} 22 23proc ejabberd::load {} { 24 variable NS_ECONFIGURE 25 variable data 26 27 set data(windows) {} 28 29 set NS_ECONFIGURE "http://ejabberd.jabberstudio.org/protocol/configure" 30 31 hook::add finload_hook [namespace current]::setup_menu 32 33 disco::browser::register_feature_handler $NS_ECONFIGURE \ 34 [namespace current]::open_win \ 35 -desc [list * [::msgcat::mc "Administrate ejabberd"]] 36 37 setup_menu 38} 39 40proc ejabberd::unload {} { 41 variable NS_ECONFIGURE 42 variable data 43 44 disco::browser::unregister_feature_handler $NS_ECONFIGURE 45 46 catch { 47 set m [.mainframe getmenu admin] 48 set idx [$m index [::msgcat::mc "Administrate ejabberd..."]] 49 $m delete $idx 50 } 51 52 catch { destroy .ejabberdserver } 53 54 foreach w $data(windows) { 55 destroy_win $w 56 } 57 58 hook::remove finload_hook [namespace current]::setup_menu 59 60 catch {unset data} 61 catch {unset NS_ECONFIGURE} 62} 63 64proc ejabberd::setup_menu {} { 65 catch { 66 set m [.mainframe getmenu admin] 67 68 $m add command -label [::msgcat::mc "Administrate ejabberd..."] \ 69 -command [namespace current]::ask_server_dialog 70 } 71} 72 73proc ejabberd::ask_server_dialog {} { 74 global ejabberd_server 75 global ejabberd_xlib 76 variable ejabberd_server_list 77 78 set gw .ejabberdserver 79 catch { destroy $gw } 80 81 if {[llength [connections]] == 0} return 82 83 set ejabberd_xlib [connection_jid [lindex [connections] 0]] 84 85 Dialog $gw -title [::msgcat::mc "ejabberd server"] -separator 1 -anchor e \ 86 -default 0 -cancel 1 87 88 set gf [$gw getframe] 89 grid columnconfigure $gf 1 -weight 1 90 91 if {[llength $ejabberd_server_list]} { 92 set ejabberd_server [lindex $ejabberd_server_list 0] 93 } 94 95 label $gf.ljid -text [::msgcat::mc "Server JID:"] 96 ComboBox $gf.jid \ 97 -textvariable ejabberd_server \ 98 -values $ejabberd_server_list \ 99 -width 35 100 101 grid $gf.ljid -row 0 -column 0 -sticky e 102 grid $gf.jid -row 0 -column 1 -sticky ew 103 104 if {[llength [connections]] > 1} { 105 foreach c [connections] { 106 lappend connections [connection_jid $c] 107 } 108 set ejabberd_xlib [lindex $connections 0] 109 110 label $gf.lxlib -text [::msgcat::mc "Connection:"] 111 ComboBox $gf.xlib \ 112 -textvariable ejabberd_xlib \ 113 -values $connections \ 114 -editable 0 115 116 grid $gf.lxlib -row 1 -column 0 -sticky e 117 grid $gf.xlib -row 1 -column 1 -sticky ew 118 } 119 120 $gw add -text [::msgcat::mc "Administrate"] -command "[namespace current]::administrate $gw" 121 $gw add -text [::msgcat::mc "Cancel"] -command "destroy $gw" 122 123 $gw draw $gf.jid 124} 125 126proc ejabberd::administrate {gw} { 127 global ejabberd_server 128 global ejabberd_xlib 129 variable ejabberd_server_list 130 131 destroy $gw 132 133 set ejabberd_server_list \ 134 [update_combo_list $ejabberd_server_list $ejabberd_server 10] 135 136 foreach c [connections] { 137 if {[connection_jid $c] == $ejabberd_xlib} { 138 set xlib $c 139 } 140 } 141 142 if {![info exists xlib]} return 143 144 open_win $xlib $ejabberd_server 145} 146 147proc ejabberd::open_win {xlib jid args} { 148 variable data 149 150 set w [win_id ejabberd $xlib:$jid] 151 if {[winfo exists $w]} { 152 raise_win $w 153 return 154 } 155 156 lappend data(windows) $w 157 158 set title [::msgcat::mc "%s administration" $jid] 159 add_win $w -title $title \ 160 -tabtitle $jid \ 161 -class Ejabberd \ 162 -raise 1 163 164 set nb [NoteBook $w.nb] 165 pack $nb -fill both -expand yes 166 167 # Binding $nb, not $w to avoid multiple calls if $w is a toplevel 168 bind $nb <Destroy> [list [namespace current]::cleanup $xlib $jid $w] 169 170 foreach {page title} \ 171 [list main [::msgcat::mc "Main"] \ 172 nodes [::msgcat::mc "Nodes"] \ 173 reg [::msgcat::mc "Registration"] \ 174 access [::msgcat::mc "Access"] \ 175 last [::msgcat::mc "Last Activity"]] { 176 set f [$nb insert end $page -text $title] 177 178 fill_page_$page $f $xlib $jid 179 } 180 $nb raise main 181} 182 183proc ejabberd::cleanup {xlib jid w} { 184 variable data 185 186 catch {unset data($xlib,$jid,total_users)} 187 catch {unset data($xlib,$jid,online_users)} 188 catch {unset data($xlib,$jid,running_nodes)} 189 catch {unset data($xlib,$jid,stopped_nodes)} 190 catch {unset data($xlib,$jid,outgoing_s2s)} 191 catch {unset data($xlib,$jid,welcome_subj)} 192 catch {unset data($xlib,$jid,welcome_body)} 193 catch {unset data($xlib,$jid,reg_watchers)} 194 catch {unset data($xlib,$jid,acls)} 195 catch {unset data($xlib,$jid,access_rules)} 196 catch {unset data($xlib,$jid,last)} 197 catch {unset data($xlib,$jid,last_int)} 198 199 set idx [lsearch -exact $data(windows) $w] 200 if {$idx >= 0} { 201 set data(windows) [lreplace $data(windows) $idx $idx] 202 } 203} 204 205proc ejabberd::add_grid_record {xlib jid info name desc row} { 206 label $info.l$name -text $desc 207 label $info.v$name -textvariable [namespace current]::data($xlib,$jid,$name) 208 grid $info.l$name -row $row -column 0 -sticky e 209 grid $info.v$name -row $row -column 1 -sticky w 210} 211 212proc ejabberd::add_grid_edit {xlib jid info name desc row} { 213 label $info.l$name -text $desc 214 entry $info.v$name -textvariable [namespace current]::data($xlib,$jid,$name) 215 grid $info.l$name -row $row -column 0 -sticky e 216 grid $info.v$name -row $row -column 1 -sticky we 217} 218 219proc ejabberd::add_grid_text {xlib jid info name desc row} { 220 label $info.l$name -text $desc 221 set sw [ScrolledWindow $info.s$name -scrollbar vertical] 222 text $info.v$name -height 6 -wrap word 223 $sw setwidget $info.v$name 224 grid $info.l$name -row $row -column 0 -sticky e 225 grid $info.s$name -row $row -column 1 -sticky we 226} 227 228proc ejabberd::fill_page_main {f xlib jid} { 229 variable data 230 231 set info [frame $f.info] 232 pack $info -side top -anchor w -fill both 233 234 grid columnconfigure $info 1 -weight 2 235 236 add_grid_record $xlib $jid $info total_users [::msgcat::mc "Registered users:"] 0 237 add_grid_record $xlib $jid $info online_users [::msgcat::mc "Online users:"] 1 238 add_grid_record $xlib $jid $info running_nodes [::msgcat::mc "Running nodes:"] 2 239 add_grid_record $xlib $jid $info stopped_nodes [::msgcat::mc "Stopped nodes:"] 3 240 add_grid_record $xlib $jid $info outgoing_s2s [::msgcat::mc "Outgoing S2S:"] 4 241 242 set reload \ 243 [button $f.reload -text [::msgcat::mc "Reload"] \ 244 -command [list [namespace current]::reload_page_main $f $xlib $jid]] 245 pack $reload -side bottom -anchor e 246 reload_page_main $f $xlib $jid 247} 248 249proc ejabberd::reload_page_main {f xlib jid} { 250 variable NS_ECONFIGURE 251 252 ::xmpp::sendIQ $xlib get \ 253 -query [::xmpp::xml::create info \ 254 -xmlns $NS_ECONFIGURE] \ 255 -to $jid \ 256 -command [list [namespace current]::parse_main_info $f $xlib $jid] 257} 258 259proc ejabberd::parse_main_info {f xlib jid status xml} { 260 variable data 261 262 if {![string equal $status ok]} { 263 return 264 } 265 266 ::xmpp::xml::split $xml tag xmlns attrs cdata subels 267 268 set data($xlib,$jid,total_users) [::xmpp::xml::getAttr $attrs registered-users] 269 set data($xlib,$jid,online_users) [::xmpp::xml::getAttr $attrs online-users] 270 set data($xlib,$jid,running_nodes) [::xmpp::xml::getAttr $attrs running-nodes] 271 set data($xlib,$jid,stopped_nodes) [::xmpp::xml::getAttr $attrs stopped-nodes] 272 set data($xlib,$jid,outgoing_s2s) [::xmpp::xml::getAttr $attrs outgoing-s2s-servers] 273} 274 275 276proc ejabberd::fill_page_nodes {f xlib jid} { 277} 278 279proc ejabberd::fill_page_reg {f xlib jid} { 280 variable data 281 282 set info [frame $f.info] 283 pack $info -side top -anchor w -fill both 284 285 grid columnconfigure $info 1 -weight 2 286 287 add_grid_edit $xlib $jid $info welcome_subj [::msgcat::mc "Welcome message subject:"] 0 288 add_grid_text $xlib $jid $info welcome_body [::msgcat::mc "Welcome message body:"] 1 289 add_grid_text $xlib $jid $info reg_watchers [::msgcat::mc "Registration watchers:"] 2 290 291 292 #set set_b [button $f.set -text [::msgcat::mc "Set"]] 293 #pack $set_b -side right -anchor se 294 set reload \ 295 [button $f.reload -text [::msgcat::mc "Reload"] \ 296 -command [list [namespace current]::reload_page_reg $f $xlib $jid]] 297 pack $reload -side right -anchor se 298 reload_page_reg $f $xlib $jid 299} 300 301proc ejabberd::reload_page_reg {f xlib jid} { 302 variable NS_ECONFIGURE 303 304 ::xmpp::sendIQ $xlib get \ 305 -query [::xmpp::xml::create welcome-message \ 306 -xmlns $NS_ECONFIGURE] \ 307 -to $jid \ 308 -command [list [namespace current]::parse_welcome_message $f $xlib $jid] 309 310 ::xmpp::sendIQ $xlib get \ 311 -query [::xmpp::xml::create registration-watchers \ 312 -xmlns $NS_ECONFIGURE] \ 313 -to $jid \ 314 -command [list [namespace current]::parse_registration_watchers $f $xlib $jid] 315} 316 317proc ejabberd::parse_welcome_message {f xlib jid status xml} { 318 variable data 319 320 set wsubj $f.info.vwelcome_subj 321 set wbody $f.info.vwelcome_body 322 323 if {![winfo exists $wsubj]} { 324 return 325 } 326 327 if {![string equal $status ok]} { 328 return 329 } 330 331 ::xmpp::xml::split $xml tag xmlns attrs cdata subels 332 333 set subj "" 334 set body "" 335 336 foreach subel $subels { 337 ::xmpp::xml::split $xml stag sxmlns sattrs scdata ssubels 338 339 switch -- $stag { 340 subject {set subj $scdata} 341 body {set body $scdata} 342 } 343 } 344 345 set data($xlib,$jid,welcome_subj) $subj 346 set data($xlib,$jid,welcome_body) $body 347 $wbody delete 0.0 end 348 $wbody insert 0.0 $body 349} 350 351proc ejabberd::parse_registration_watchers {f xlib jid status xml} { 352 variable data 353 354 set wwatchers $f.info.vreg_watchers 355 356 if {![winfo exists $wwatchers]} { 357 return 358 } 359 360 if {![string equal $status ok]} { 361 return 362 } 363 364 ::xmpp::xml::split $xml tag xmlns attrs cdata subels 365 366 set jids {} 367 368 foreach subel $subels { 369 ::xmpp::xml::split $xml stag sxmlns sattrs scdata ssubels 370 371 switch -- $tag1 { 372 jid {lappend jids $scdata} 373 } 374 } 375 376 set data($xlib,$jid,reg_watchers) $jids 377 $wwatchers delete 0.0 end 378 $wwatchers insert 0.0 [join $jids \n] 379} 380 381proc ejabberd::fill_page_access {f xlib jid} { 382 variable data 383 384 set info [frame $f.info] 385 pack $info -side top -anchor w -fill both 386 387 grid columnconfigure $info 1 -weight 2 388 389 add_grid_text $xlib $jid $info acls [::msgcat::mc "ACLs:"] 0 390 add_grid_text $xlib $jid $info access_rules [::msgcat::mc "Access rules:"] 1 391 392 393 #set set_b [button $f.set -text [::msgcat::mc "Set"]] 394 #pack $set_b -side right -anchor se 395 set reload \ 396 [button $f.reload -text [::msgcat::mc "Reload"] \ 397 -command [list [namespace current]::reload_page_access $f $xlib $jid]] 398 pack $reload -side right -anchor se 399 400 reload_page_access $f $xlib $jid 401} 402 403proc ejabberd::reload_page_access {f xlib jid} { 404 variable NS_ECONFIGURE 405 406 ::xmpp::sendIQ $xlib get \ 407 -query [::xmpp::xml::create acls \ 408 -xmlns $NS_ECONFIGURE] \ 409 -to $jid \ 410 -command [list [namespace current]::parse_access acls $f $xlib $jid] 411 412 ::xmpp::sendIQ $xlib get \ 413 -query [::xmpp::xml::create access \ 414 -xmlns $NS_ECONFIGURE] \ 415 -to $jid \ 416 -command [list [namespace current]::parse_access access_rules $f $xlib $jid] 417} 418 419proc ejabberd::parse_access {var f xlib jid status xml} { 420 variable data 421 422 set w $f.info.v$var 423 424 if {![winfo exists $w]} { 425 return 426 } 427 428 if {![string equal $status ok]} { 429 return 430 } 431 432 ::xmpp::xml::split $xml tag xmlns attrs cdata subels 433 434 set data($xlib,$jid,$var) $cdata 435 $w delete 0.0 end 436 $w insert 0.0 $cdata 437} 438 439proc ejabberd::fill_page_last {f xlib jid} { 440 variable data 441 442 set info [frame $f.info] 443 pack $info -side top -anchor w -fill both -expand yes 444 445 #grid columnconfigure $info 1 -weight 2 446 447 #add_grid_text $xlib $jid $info acls [::msgcat::mc "ACLs:"] 0 448 #add_grid_text $xlib $jid $info access_rules [::msgcat::mc "Access rules:"] 1 449 450 label $info.lplot \ 451 -text [::msgcat::mc \ 452 "Number of users that used this service N days ago:"] 453 pack $info.lplot -side top -anchor w 454 455 set sw [ScrolledWindow $info.sw] 456 pack $sw -side top -fill both -expand yes 457 set plot [canvas $info.plot -background white] 458 $sw setwidget $plot 459 460 set data($xlib,$jid,last) {} 461 set data($xlib,$jid,last_int) 0 462 463 set integral \ 464 [checkbutton $f.integral -text [::msgcat::mc "Integral"] \ 465 -variable [namespace current]::data($xlib,$jid,last_int) \ 466 -command [list [namespace current]::redraw_last $f $xlib $jid]] 467 pack $integral -side left -anchor se 468 469 set reload \ 470 [button $f.reload -text [::msgcat::mc "Reload"] \ 471 -command [list [namespace current]::reload_page_last $f $xlib $jid]] 472 pack $reload -side right -anchor se 473} 474 475proc ejabberd::reload_page_last {f xlib jid} { 476 variable NS_ECONFIGURE 477 478 ::xmpp::sendIQ $xlib get \ 479 -query [::xmpp::xml::create last \ 480 -xmlns $NS_ECONFIGURE] \ 481 -to $jid \ 482 -command [list [namespace current]::parse_last $f $xlib $jid] 483} 484 485proc ejabberd::parse_last {f xlib jid status xml} { 486 variable data 487 488 set plot $f.info.plot 489 490 if {![winfo exists $plot]} { 491 return 492 } 493 494 if {![string equal $status ok]} { 495 return 496 } 497 498 ::xmpp::xml::split $xml tag xmlns attrs cdata subels 499 500 set data($xlib,$jid,last) $cdata 501 502 redraw_last $f $xlib $jid 503} 504 505proc ejabberd::redraw_last {f xlib jid} { 506 variable data 507 508 set plot $f.info.plot 509 510 set maxdays 0 511 512 foreach t $data($xlib,$jid,last) { 513 set days [expr {$t / (60*60*24)}] 514 if {$days > $maxdays} {set maxdays $days} 515 516 if {![info exists last($days)]} { 517 set last($days) 0 518 } 519 incr last($days) 520 } 521 522 set xscale 20 523 set yscale 200 524 525 $plot delete all 526 527 set val 0 528 529 for {set i 0} {$i <= $maxdays} {incr i} { 530 if {[info exists last($i)]} { 531 set v $last($i) 532 } else { 533 set v 0 534 } 535 536 if {$data($xlib,$jid,last_int)} { 537 incr val $v 538 } else { 539 set val $v 540 } 541 542 set x1 [expr {$xscale * $i}] 543 set x2 [expr {$xscale * ($i+1)}] 544 set x [expr {($x1 + $x2)/2}] 545 set y [expr {-$yscale * $val}] 546 547 $plot create rectangle $x1 0 $x2 $y -fill red 548 549 $plot create text $x 0 -text $i -anchor n 550 $plot create text $x $y -text $val -anchor s 551 } 552 553 set bbox [$plot bbox all] 554 555 set y1 [lindex $bbox 1] 556 set y2 [lindex $bbox 3] 557 set height [winfo height $plot] 558 559 $plot scale all 0 0 1 [expr {0.9 * $height / (0.0 + $y2 - $y1)}] 560 $plot configure -scrollregion [$plot bbox all] 561} 562 563