rac-gui/lib/function.tcl

2482 lines
99 KiB
Tcl
Raw Blame History

This file contains ambiguous Unicode characters!

This file contains ambiguous Unicode characters that may be confused with others in your current locale. If your use case is intentional and legitimate, you can safely ignore this warning. Use the Escape button to highlight these characters.

##########################################
# Rac GUI
# Distributed under GNU Public License
# Author: Sergey Kalinin svk@nuk-svk.ru
# Copyright (c) "http://nuk-svk.ru", 2018
# https://bitbucket.org/svk28/rac-gui
###########################################
proc Quit {} {
exit
}
set active_cluster ""
set host ""
set infobase ""
set server ""
proc TreePress {tree} {
global host server active_cluster infobase
set id [$tree selection]
$tree tag remove selected
$tree item $id -tags selected
SetGlobalVarFromTreeItems $tree $id
set values [$tree item $id -values]
set key [lindex [split $id "::"] 0]
if {$values eq "" || $key eq ""} {return}
Run::$key $tree $host $values
}
proc SetGlobalVarFromTreeItems {tree id} {
global host server active_cluster infobase profile_name dir rac_cmd_for_host rac_cmd
set parent [$tree parent $id]
set values [$tree item $id -values]
set key [lindex [split $id "::"] 0]
switch -- $key {
server {
set host $values
set orig_file [open [file join $dir(work) 1c_srv.cfg] "r"]
while {[gets $orig_file line] >=0 } {
if [string match "$host*" $line] {
set path_to_rac [string trim [lindex [split $line ","] 1]]
if {$path_to_rac eq ""} {
set rac_cmd_for_host($host) "$rac_cmd"
} else {
set rac_cmd_for_host($host) $path_to_rac
set rac_cmd $path_to_rac
}
}
}
close $orig_file
}
work_server {set server $values}
cluster {set active_cluster $values}
infobase {set infobase $values}
profile {set profile_name $values}
}
if {$parent eq ""} {
return
} else {
SetGlobalVarFromTreeItems $tree $parent
}
}
proc InsertItemsWorkList {lst} {
global work_list_row_count
if [expr $work_list_row_count % 2] {
set tag light
} else {
set tag dark
}
foreach i $lst {
if [regexp -nocase -all -- {(\D+)(\s*?|)(:)(\s*?|)(.*)} $i match param v2 v3 v4 value] {
lappend column_list [string trim $param]
lappend value_list [string trim $value]
}
}
.frm_work.tree_work configure -columns $column_list -displaycolumns $column_list
.frm_work.tree_work insert {} end -values $value_list -tags $tag
.frm_work.tree_work column #0 -stretch
foreach j $column_list {
.frm_work.tree_work heading $j -text $j
}
incr work_list_row_count
}
proc RunCommand {par} {
global dir rac_cmd cluster work_list_row_count \
agent_user agent_pwd cluster_user cluster_pwd server_platform
set host [lindex [split $par " "] end]
set work_list_row_count 0
puts "$rac_cmd $par"
set pipe [open "|\"$rac_cmd\" $par" "r"]
try {
set lst ""
set l ""
while {[gets $pipe line]>=0} {
#puts $line
if {$line eq ""} {
lappend l $lst
set lst ""
} else {
lappend lst [string trim $line]
}
}
close $pipe
return $l
} on error {result options} {
puts "Handle >$result< "
ErrorParcing $result $options
return ""
#RunCommand $root $par
}
# fileevent $pipe readable [list DebugInfo .frm_work.tree_work $pipe]
# fconfigure $pipe -buffering none -blocking no
}
proc ErrorParcing {err opt} {
global cluster_user cluster_pwd agent_user agent_pwd
switch -regexp -- $err {
"Cluster administrator is not authenticated" {
AuthorisationDialog [::msgcat::mc "Cluster administrator"]
.auth_win.frm_btn.btn_ok configure -command {
set cluster_user [.auth_win.frm.ent_name get]
set cluster_pwd [.auth_win.frm.ent_pwd get]
destroy .auth_win
}
#RunCommand $root $par
}
"Central server administrator is not authenticated" {
AuthorisationDialog [::msgcat::mc "Agent cluster administrator"]
.auth_win.frm_btn.btn_ok configure -command {
set agent_user [.auth_win.frm.ent_name get]
set agent_pwd [.auth_win.frm.ent_pwd get]
destroy .auth_win
}
}
"Администратор кластера не аутентифицирован" {
AuthorisationDialog [::msgcat::mc "Cluster administrator"]
.auth_win.frm_btn.btn_ok configure -command {
set cluster_user [.auth_win.frm.ent_name get]
set cluster_pwd [.auth_win.frm.ent_pwd get]
destroy .auth_win
}
#RunCommand $root $par
}
"Администратор центрального сервера не аутентифицирован" {
AuthorisationDialog [::msgcat::mc "Agent cluster administrator"]
.auth_win.frm_btn.btn_ok configure -command {
set agent_user [.auth_win.frm.ent_name get]
set agent_pwd [.auth_win.frm.ent_pwd get]
destroy .auth_win
}
}
(.+) {
tk_messageBox -type ok -icon error -message "$err"
}
}
}
proc AuthorisationDialog {txt} {
global active_cluster agent_user agent_pwd cluster_user cluster_pwd
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set frm [AddToplevel "$txt" administrator_grey_64 .auth_win]
wm title .auth_win [::msgcat::mc "Authorization"]
ttk::label $frm.lbl_name -text [::msgcat::mc "User name"]
ttk::entry $frm.ent_name
ttk::label $frm.lbl_pwd -text [::msgcat::mc "Password"]
ttk::entry $frm.ent_pwd
grid $frm.lbl_name -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_pwd -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_pwd -row 1 -column 1 -sticky nsew -padx 5 -pady 5
grid columnconfigure $frm 0 -weight 1
grid rowconfigure $frm 0 -weight 1
#set frm_btn [frame .add.frm_btn -border 0]
}
proc InsertClusterItems {tree id} {
set parent "cluster::$id"
$tree insert $parent end -id "infobases::$id" -text [::msgcat::mc "Infobases"] -values "$id"
$tree insert $parent end -id "servers::$id" -text [::msgcat::mc "Work servers"] -values "$id"
$tree insert $parent end -id "admins::$id" -text [::msgcat::mc "Administrators"] -values "$id"
$tree insert $parent end -id "managers::$id" -text [::msgcat::mc "Cluster managers"] -values $id
$tree insert $parent end -id "processes::$id" -text [::msgcat::mc "Working processes"] -values "workprocess-all"
$tree insert $parent end -id "sessions::$id" -text [::msgcat::mc "Sessions"] -values "sessions-all"
$tree insert $parent end -id "locks::$id" -text [::msgcat::mc "Blocks"] -values "blocks-all"
$tree insert $parent end -id "connections::$id" -text [::msgcat::mc "Connections"] -values "connections-all"
$tree insert $parent end -id "profiles::$id" -text [::msgcat::mc "Security profiles"] -values $id
}
proc InsertBaseItems {tree id} {
set parent "infobase::$id"
if { [$tree exists "sessions::$id"] == 0 } {
$tree insert $parent end -id "sessions::$id" -text [::msgcat::mc "Sessions"] -values "$id"
}
if { [$tree exists "locks::$id"] == 0 } {
$tree insert $parent end -id "locks::$id" -text [::msgcat::mc "Blocks"] -values "$id"
}
if { [$tree exists "connections::$id"] == 0 } {
$tree insert $parent end -id "connections::$id" -text [::msgcat::mc "Connections"] -values "$id"
}
}
proc InsertWorkServerItems {tree id} {
set parent "work_server::$id"
if { [$tree exists "work_server_processes::$id"] == 0 } {
$tree insert $parent end -id "work_server_processes::$id" -text [::msgcat::mc "Working processes"] -values "$id"
}
if { [$tree exists "work_server_licenses::$id"] == 0 } {
$tree insert $parent end -id "work_server_licenses::$id" -text [::msgcat::mc "Licenses"] -values "$id"
}
if { [$tree exists "rule::$id"] == 0 } {
$tree insert $parent end -id "rule::$id" -text [::msgcat::mc "Assignment rule"] -values "$id"
}
if { [$tree exists "services::$id"] == 0 } {
# $tree insert $parent end -id "services::$id" -text "Сервисы" -values "$id"
}
}
proc InsertProfileItems {tree id} {
set parent "profile::$id"
set lst {
{directory "Virtual directory"}
{com "Available COM class"}
{addin "Available add-in"}
{module "Available external modules"}
{app "Available applications"}
{inet "Available internet resurces"}
}
foreach i $lst {
append item [lindex $i 0] "::$id"
if { [$tree exists $item] == 0 } {
$tree insert $parent end -id $item -text [::msgcat::mc "[lindex $i 1]"] -values "$id"
}
unset item
}
}
proc GetInfobases {cluster host} {
global active_cluster cluster_user cluster_pwd auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set lst [RunCommand "infobase summary --cluster=$cluster $auth list $host"]
set return_list ""
foreach info_bases_list $lst {
foreach i $info_bases_list {
set i [split $i ":"]
if {[string trim [lindex $i 0]] eq "name"} {
lappend return_list [string trim [lindex $i 1]]
}
}
}
return $return_list
}
proc FormFieldsDataInsert {frm lst} {
foreach i [lindex $lst 0] {
if [regexp -nocase -all -- {(\D+)(\s*?|)(:)(\s*?|)(.*)} $i match param v2 v3 v4 value] {
regsub -all -- "-" [string trim $param] "_" entry_name
if [winfo exists $frm.ent_$entry_name] {
$frm.ent_$entry_name delete 0 end
$frm.ent_$entry_name insert end [string trim $value "\""]
}
if [winfo exists $frm.cb_$entry_name] {
global $entry_name
set $entry_name [string trim $value "\""]
}
if [winfo exists $frm.check_$entry_name] {
global $entry_name
if {$value eq "0"} {
set $entry_name no
} elseif {$value eq "1"} {
set $entry_name yes
} else {
set $entry_name $value
}
}
}
}
}
proc SaveMainServer {host port path_to_rac} {
global dir rac_cmd
if {$path_to_rac ne ""} {
set rac_cmd $path_to_rac
}
set file [open [file join $dir(work) 1c_srv.cfg] "a+"]
puts "$host:$port $rac_cmd"
puts $file "$host:$port,$rac_cmd"
close $file
return "$host:$port"
}
proc GetWorkTreeItems {par} {
set work_tree_id [.frm_work.tree_work selection]
set work_tree_values [.frm_work.tree_work item $work_tree_id -values]
#puts ">$work_tree_id >$work_tree_values"
set id [.frm_tree.tree selection]
#set values [.frm_tree.tree item $id -values]
set key [lindex [split $id "::"] 0]
set column_list [.frm_work.tree_work cget -columns]
set i 0
# проверка соответсвия колонки в таблице и ключа в дереве
foreach l $column_list {
if {$l eq $par } {
set item_id [lindex $work_tree_values $i]
set tree .frm_work.tree_work
}
incr i
}
return $item_id
}
proc GetWorkTreeRow {} {
set work_tree_id [.frm_work.tree_work selection]
if {$work_tree_id eq ""} {
return
}
set work_tree_values_list [.frm_work.tree_work item $work_tree_id -values]
set column_list [.frm_work.tree_work cget -columns]
set l1 [llength $column_list]
set l2 [llength $work_tree_values_list]
if {$l1 == $l2} {
for {set i 0} {$i <= $l1 } {incr i} {
lappend lst "[lindex $column_list $i] : [lindex $work_tree_values_list $i]"
}
} else {
return
}
return $lst
}
proc JsonGet {json args} {
foreach key $args {
if {[dict exists $json $key]} {
set json [dict get $json $key]
} elseif {[string is integer $key]} {
if {$key >= 0 && $key < [llength $json]} {
set json [lindex $json $key]
} else {
error "can't get item number $key from {$json}"
}
} else {
error "can't get \"$key\": no such key in {$json}"
}
}
return $json
}
proc CreateInfoBasesJSONfile {} {
global default dir
set info_base_json_file [file join $dir(work) infobases.lst]
set jsonStr { \
{
"servers":[
{ "server-id": "server_id1",
"clusters": [
{"cluster-id": "cluster_id_1", "infobases": [
{"infobase-uid": "infobase_uid_1", "infobase-user":"infobase_user", "infobase-pwd":"infobase_pwd"},
{"infobase-uid": "infobase_uid_2", "infobase-user":"infobase_user", "infobase-pwd":"infobase_pwd"}]
}
]
},
{ "server-id": "server_id2",
"clusters": [
{"cluster-id": "cluster_id_1", "infobases": [
{"infobase-uid": "infobase_uid_1", "infobase-user":"infobase_user", "infobase-pwd":"infobase_pwd"},
{"infobase-uid": "infobase_uid_2", "infobase-user":"infobase_user", "infobase-pwd":"infobase_pwd"}]
}
]}
]}
}
}
namespace eval Run {} {}
# Получение данных по кластерам
proc Run::server {tree host values} {
global rac_cmd_for_host rac_cmd
if {[info exists rac_cmd_for_host($host)] == 1 && $rac_cmd_for_host($host) ne "" } {
set rac_cmd $rac_cmd_for_host($host)
}
set lst [RunCommand "cluster list $host"]
if {$lst eq ""} {return}
set l [lindex $lst 0]
#puts $lst
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
foreach cluster_list $lst {
InsertItemsWorkList $cluster_list
foreach i $cluster_list {
#puts $i
set cluster_list [split $i ":"]
if {[string trim [lindex $cluster_list 0]] eq "cluster"} {
set cluster_id [string trim [lindex $cluster_list 1]]
lappend cluster($cluster_id) $cluster_id
}
if {[string trim [lindex $cluster_list 0]] eq "name"} {
lappend cluster($cluster_id) [string trim [lindex $cluster_list 1]]
}
}
}
foreach x [array names cluster] {
set id [lindex $cluster($x) 0]
if { [$tree exists "cluster::$id"] == 0 } {
$tree insert "server::$host" end -id "cluster::$id" -text "[lindex $cluster($x) 1]" -values "$id"
InsertClusterItems $tree $id
}
}
if { [$tree exists "agent_admins::$id"] == 0 } {
$tree insert "server::$host" end -id "agent_admins::$id" -text [::msgcat::mc "Administrators"] -values "$id"
#InsertClusterItems $tree $id
}
}
proc Run::cluster {tree host values} {
global active_cluster
set active_cluster $values
RunCommand "cluster info --cluster=$values $host"
}
proc Run::cluster_managers {tree host values} {
}
proc Run::services {tree host values} {
global active_cluster
Run::List $tree $host $active_cluster service
}
proc Run::infobases {tree host values} {
global active_cluster cluster_user cluster_pwd
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set lst [RunCommand "infobase summary --cluster=$active_cluster $auth list $host"]
#puts $lst
foreach info_bases_list $lst {
foreach i $info_bases_list {
set base_list [split $i ":"]
if {[string trim [lindex $base_list 0]] eq "infobase"} {
set base_id [string trim [lindex $base_list 1]]
lappend base($base_id) $base_id
}
if {[string trim [lindex $base_list 0]] eq "name"} {
lappend base($base_id) [string trim [lindex $base_list 1]]
}
#InsertItemsWorkList $base_list
}
InsertItemsWorkList $info_bases_list
}
foreach x [array names base] {
set id [lindex $base($x) 0]
if { [$tree exists "infobase::$id"] == 0 } {
$tree insert "infobases::$values" end -id "infobase::$id" -text "[lindex $base($x) 1]" -values "$id"
}
InsertBaseItems $tree $id
}
}
proc Run::infobase {tree host values} {
global active_cluster cluster_user cluster_pwd default
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
#### Временный костыль ####
if {[info exists default(infobase_user)] == 1 && [info exists default(infobase_pwd)] == 1} {
set ib_auth "--infobase-user=$default(infobase_user) --infobase-pwd=$default(infobase_pwd)"
} else {
set ib_auth ""
}
###########################
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand "infobase info --cluster=$active_cluster $auth --infobase=$values $ib_auth $host"]
foreach l $lst {
InsertItemsWorkList $l
}
}
proc Run::List:Base {tree host values par} {
global active_cluster cluster_user cluster_pwd
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand "$par list --cluster=$active_cluster $auth --infobase=$values $host"]
foreach l $lst {
InsertItemsWorkList $l
}
}
proc Run::List {tree host values par} {
global active_cluster cluster_user cluster_pwd
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand "$par list --cluster=$active_cluster $auth $host"]
foreach l $lst {
InsertItemsWorkList $l
}
}
proc Run::sessions {tree host values} {
Run::List:Base $tree $host $values session
}
proc Run::locks {tree host values} {
Run::List:Base $tree $host $values lock
}
proc Run::connections {tree host values} {
Run::List:Base $tree $host $values connection
}
proc Run::servers {tree host values} {
global active_cluster cluster_user cluster_pwd
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set lst [RunCommand "server list --cluster=$active_cluster $auth $host"]
if {$lst eq ""} {return}
foreach l $lst {
foreach i $l {
set server_list [split $i ":"]
#InsertItemsWorkList $server_list
if {[string trim [lindex $server_list 0]] eq "server"} {
set server_id [string trim [lindex $server_list 1]]
lappend server($server_id) $server_id
}
if {[string trim [lindex $server_list 0]] eq "name"} {
lappend server($server_id) [string trim [lindex $server_list 1]]
}
}
#puts $l
InsertItemsWorkList $l
}
foreach x [array names server] {
set id [lindex $server($x) 0]
if { [$tree exists "work_server::$id"] == 0 } {
$tree insert "servers::$values" end -id "work_server::$id" \
-text "[lindex $server($x) 1]" -values "$id"
}
InsertWorkServerItems $tree $id
}
#Run::List $tree $host $values server
}
proc Run::work_server {tree host values} {
global active_cluster work_list_row_count cluster_user cluster_pwd
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand "server info --cluster=$active_cluster --server=$values $auth $host"]
foreach l $lst {
InsertItemsWorkList $l
}
}
proc Run::profile {tree host values} {
return
}
proc Run::profiles {tree host values} {
global active_cluster work_list_row_count cluster_user cluster_pwd
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand "profile list --cluster=$active_cluster $auth $host"]
foreach l $lst {
foreach i $l {
set profile_list [split $i ":"]
#InsertItemsWorkList $server_list
if {[string trim [lindex $profile_list 0]] eq "name"} {
set profile_name [string trim [lindex $profile_list 1]]
#set profile_name [regsub -all -- " " $profile_name "_"]
lappend profiles($profile_name) $profile_name
}
}
#puts $l
InsertItemsWorkList $l
}
foreach x [array names profiles] {
set id [lindex $profiles($x) 0]
#set id_for_tree [regsub -all -- " " $id "_"]
if { [$tree exists "profile::$id"] == 0 } {
$tree insert "profiles::$values" end -id "profile::$id" \
-text $id -values "$id"
}
InsertProfileItems $tree $id
}
}
proc Run::processes {tree host values} {
Run::List $tree $host $values process
}
proc Run::work_server_processes {tree host values} {
global active_cluster work_list_row_count cluster_user cluster_pwd
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand "process list --cluster=$active_cluster $auth --server=$values $host"]
foreach l $lst {
InsertItemsWorkList $l
}
}
proc Run::work_server_licenses {tree host values} {
global active_cluster work_list_row_count cluster_user cluster_pwd
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand "process list --cluster=$active_cluster $auth --server=$values --licenses $host"]
foreach l $lst {
InsertItemsWorkList $l
}
}
proc Run::managers {tree host values} {
#Run::List $tree $host $values manager
global active_cluster work_list_row_count cluster_user cluster_pwd
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand "manager list --cluster=$active_cluster $auth $host"]
foreach l $lst {
foreach i $l {
set server_list [split $i ":"]
#InsertItemsWorkList $server_list
if {[string trim [lindex $server_list 0]] eq "manager"} {
set server_id [string trim [lindex $server_list 1]]
lappend server($server_id) $server_id
}
if {[string trim [lindex $server_list 0]] eq "host"} {
lappend server($server_id) [string trim [lindex $server_list 1]]
}
}
#puts $l
InsertItemsWorkList $l
}
foreach x [array names server] {
set id [lindex $server($x) 0]
if { [$tree exists "manager::$id"] == 0 } {
$tree insert "managers::$values" end -id "manager::$id" \
-text "[lindex $server($x) 1]" -values "$id"
}
#InsertWorkServerItems $tree $id
}
#Run::List $tree $host $values server
}
proc Run::manager {tree host values} {
#Run::List $tree $host $values service
global active_cluster cluster_user cluster_pwd
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand "service list --cluster=$active_cluster $auth $host"]
foreach l $lst {
#puts $l
foreach i $l {
set temp_lst [split $i ":"]
if {[string trim [lindex $temp_lst 0]] eq "manager" && [string match "*$values*" [string trim [lindex $temp_lst 1]]] == 1 } {
InsertItemsWorkList $l
}
}
}
}
proc Run::agent_admin {tree host values} {
Run::admins $tree $host $values
}
proc Run::agent_admins {tree host values} {
global active_cluster agent_user agent_pwd
if {$agent_user ne "" && $agent_pwd ne ""} {
set agent_auth "--agent-user=$agent_user --agent-pwd=$agent_pwd"
} else {
set agent_auth ""
}
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand "agent admin list $agent_auth $host"]
foreach l $lst {
InsertItemsWorkList $l
}
}
proc Run::admins {tree host values} {
global active_cluster agent_user agent_pwd cluster_user cluster_pwd
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [
RunCommand "cluster admin list $auth --cluster=$active_cluster $host"
]
foreach l $lst {
InsertItemsWorkList $l
}
}
proc Run::rule {tree host values} {
global active_cluster cluster_user cluster_pwd
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand "rule list --cluster=$active_cluster $auth --server=$values $host"]
foreach l $lst {
#puts $l
InsertItemsWorkList $l
}
}
proc Run::directory {tree host values} {
Run::acl $host $values directory
}
proc Run::com {tree host values} {
Run::acl $host $values com
}
proc Run::addin {tree host values} {
Run::acl $host $values addin
}
proc Run::module {tree host values} {
Run::acl $host $values module
}
proc Run::app {tree host values} {
Run::acl $host $values app
}
proc Run::inet {tree host values} {
Run::acl $host $values inet
}
proc Run::acl {host values mode} {
global active_cluster cluster_user cluster_pwd profile_name
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand "profile acl $mode list --cluster=$active_cluster --name=$profile_name $auth $host"]
foreach l $lst {
#puts $l
InsertItemsWorkList $l
}
}
proc Add {} {
global active_cluster host
set id [.frm_tree.tree selection]
set values [.frm_tree.tree item [.frm_tree.tree selection] -values]
set key [lindex [split $id "::"] 0]
if {$key eq "" || $key eq "server"} {
set host [ Add::server ]
return
}
#puts "$key, $id , $values"
Add::$key .frm_tree.tree $host $values
}
proc AddToplevel_ {lbl img {win_name .add}} {
set cmd "destroy $win_name"
if [winfo exists $win_name] {destroy $win_name}
toplevel $win_name
wm title $win_name [::msgcat::mc "Add record"]
wm iconphoto $win_name tcl
set frm [ttk::labelframe $win_name.frm -text $lbl -labelanchor nw]
grid columnconfigure $frm 0 -weight 1
grid rowconfigure $frm 0 -weight 1
set frm_btn [ttk::frame $win_name.frm_btn ]
ttk::label $frm_btn.lbl -image $img
ttk::button $frm_btn.btn_ok -image ok_grey_24 -command { }
ttk::button $frm_btn.btn_cancel -command $cmd -image quit_grey_24
grid $frm_btn -row 0 -column 0 -sticky sn -padx 1 -pady 1
grid $frm -row 0 -column 1 -sticky nwe -padx 1 -pady 1
pack $frm_btn.lbl -side top
pack $frm_btn.btn_cancel $frm_btn.btn_ok -side bottom -fill x -padx 5 -pady 5
#pack $frm_btn.btn_ok -side bottom -padx 1
return $frm
}
proc AddToplevel {lbl img {win_name .add}} {
set cmd "destroy $win_name"
if [winfo exists $win_name] {destroy $win_name}
toplevel $win_name
wm title $win_name [::msgcat::mc "Add record"]
wm iconphoto $win_name tcl
ttk::label $win_name.lbl -image $img -anchor nw
set frm [ttk::labelframe $win_name.frm -text $lbl -labelanchor nw]
grid columnconfigure $frm 0 -weight 1
grid rowconfigure $frm 0 -weight 1
set frm_btn [ttk::frame $win_name.frm_btn ]
ttk::button $frm_btn.btn_ok -image ok_grey_24 -command { }
ttk::button $frm_btn.btn_cancel -command $cmd -image quit_grey_24
grid $win_name.lbl -row 0 -column 0 -sticky nsw -padx 0 -pady 1 -rowspan 2
grid $frm -row 0 -column 1 -sticky nw -padx 2 -pady 2
grid $frm_btn -row 1 -column 1 -sticky sew -padx 0 -pady 0
pack $frm_btn.btn_cancel $frm_btn.btn_ok -side right -padx 5 -pady 5
#pack $frm_btn.btn_ok -side right -padx 2
return $frm
}
namespace eval Add {} {}
proc Add::agent_admins {tree host value} {
Add::agent_admin $tree $host $value
}
proc Add::agent_admin {tree host value} {
global default auth active_cluster
set frm [AddToplevel [::msgcat::mc "Agent cluster addministrator"] administrator_grey_64]
set auth [lindex $default(auth) 0]
ttk::label $frm.lbl_name -text [::msgcat::mc "User name"]
ttk::entry $frm.ent_name
ttk::label $frm.lbl_pwd -text [::msgcat::mc "Password"]
ttk::entry $frm.ent_pwd
ttk::label $frm.lbl_descr -text [::msgcat::mc "Description"]
ttk::entry $frm.ent_descr
ttk::label $frm.lbl_auth -text [::msgcat::mc "Authentication method"]
ttk::combobox $frm.cb_auth -textvariable auth -values $default(auth)
ttk::label $frm.lbl_os_user -text [::msgcat::mc "OS user name"]
ttk::entry $frm.ent_os_user
grid $frm.lbl_name -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_pwd -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_pwd -row 1 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_descr -row 2 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_descr -row 2 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_auth -row 3 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_auth -row 3 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_os_user -row 4 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_os_user -row 4 -column 1 -sticky nsew -padx 5 -pady 5
grid columnconfigure $frm 0 -weight 1
grid rowconfigure $frm 0 -weight 1
#set frm_btn [frame .add.frm_btn -border 0]
.add.frm_btn.btn_ok configure -command {
RunCommand "agent admin register \
--name=[.add.frm.ent_name get] \
--pwd=[.add.frm.ent_pwd get] \
--descr=[.add.frm.ent_descr get] \
--auth=$auth \
--os-user=[.add.frm.ent_os_user get] $host"
#--cluster=$active_cluster $host"
Run::admins $tree $host $active_cluster
destroy .add
}
return $frm
}
proc Add::admins {tree host value} {
Add::admin $tree $host $value
}
proc Add::admin {tree host value} {
global default auth active_cluster agent_user agent_pwd cluster_user cluster_pwd
set frm [Add::agent_admin $tree $host $value]
$frm configure -text [::msgcat::mc "Cluster administrator"]
#.add.frm configure -text [::msgcat::mc "Add record"]
.add.frm_btn.btn_ok configure -command {
RunCommand "cluster admin register \
--name=[.add.frm.ent_name get] \
--pwd=[.add.frm.ent_pwd get] \
\"--descr=[regsub -all -- " " [.add.frm.ent_descr get] "\\ "]\" \
--auth=$auth \
--os-user=[.add.frm.ent_os_user get] \
--agent-user=$agent_user \
--agent-pwd=$agent_pwd
--cluster-user=$cluster_user \
--cluster-pwd=$cluster_pwd \
--cluster=$active_cluster $host"
#--cluster=$active_cluster $host"
Run::admins $tree $host $active_cluster
destroy .add
}
return $frm
}
proc Add::server {} {
global default rac_cmd_for_host
set frm [AddToplevel [::msgcat::mc "Main server"] server_grey_64]
ttk::label $frm.lbl_host -text [::msgcat::mc "Address"]
ttk::entry $frm.ent_host
ttk::label $frm.lbl_port -text [::msgcat::mc "Port"]
ttk::entry $frm.ent_port
ttk::label $frm.lbl_path_to_rac -text [::msgcat::mc "Path to RAC"]
ttk::entry $frm.ent_path_to_rac
$frm.ent_port insert end $default(port)
grid $frm.lbl_host -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_host -row 0 -column 1 -sticky new -padx 5 -pady 5
grid $frm.lbl_port -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_port -row 1 -column 1 -sticky new -padx 5 -pady 5
grid $frm.lbl_path_to_rac -row 2 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_path_to_rac -row 2 -column 1 -sticky new -padx 5 -pady 5
grid columnconfigure $frm 0 -weight 1
grid rowconfigure $frm 0 -weight 1
#set frm_btn [frame .add.frm_btn -border 0]
.add.frm_btn.btn_ok configure -command {
set host [SaveMainServer [.add.frm.ent_host get] [.add.frm.ent_port get] [.add.frm.ent_path_to_rac get]]
set rac_cmd_for_host($host) [.add.frm.ent_path_to_rac get]
.frm_tree.tree insert {} end -id "server::$host" -text "$host" -values "$host"
destroy .add
return $host
}
return $frm
}
proc Add::servers {tree host values} {
global default dedicate_managers using active_cluster cluster_user cluster_pwd auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set dedicate_managers "none"
set using "normal"
#set active_cluster $values
set frm [AddToplevel [::msgcat::mc "Work server"] server_grey_64]
ttk::label $frm.lbl_name -text [::msgcat::mc "Name"]
ttk::entry $frm.ent_name
ttk::label $frm.lbl_agent_host -text [::msgcat::mc "Address"]
ttk::entry $frm.ent_agent_host
ttk::label $frm.lbl_agent_port -text [::msgcat::mc "Port"]
ttk::entry $frm.ent_agent_port
$frm.ent_agent_port insert end $default(port)
ttk::label $frm.lbl_port_range -text [::msgcat::mc "Ports range"]
ttk::entry $frm.ent_port_range
$frm.ent_port_range insert end $default(port_range)
ttk::label $frm.lbl_safe_working_processes_memory_limit -text [::msgcat::mc "Maximum memory in working processes"]
ttk::entry $frm.ent_safe_working_processes_memory_limit
$frm.ent_safe_working_processes_memory_limit insert end $default(safe_working_processes_memory_limit)
ttk::label $frm.lbl_safe_call_memory_limit -text [::msgcat::mc "Safe memory consuption per call"]
ttk::entry $frm.ent_safe_call_memory_limit
$frm.ent_safe_call_memory_limit insert end $default(safe_call_memory_limit)
ttk::label $frm.lbl_memory_limit -text [::msgcat::mc "Memory use limit per working process"]
ttk::entry $frm.ent_memory_limit
$frm.ent_memory_limit insert end $default(ram_work)
ttk::label $frm.lbl_infobases_limit -text [::msgcat::mc "Maximum number of infobases per working process"]
ttk::entry $frm.ent_infobases_limit
$frm.ent_infobases_limit insert end $default(infobases_limit)
ttk::label $frm.lbl_connections_limit -text [::msgcat::mc "Maximum nuber of connections per working process"]
ttk::entry $frm.ent_connections_limit
$frm.ent_connections_limit insert end $default(connections_limit)
ttk::label $frm.lbl_cluster_port -text [::msgcat::mc "Main cluster manager port number"]
ttk::entry $frm.ent_cluster_port
$frm.ent_cluster_port insert end $default(port)
ttk::label $frm.lbl_dedicate_managers -text [::msgcat::mc "Service manager allocation"]
ttk::checkbutton $frm.check_dedicate_managers -variable dedicate_managers -onvalue all -offvalue none
ttk::label $frm.lbl_using -text [::msgcat::mc "Working server use variant"]
ttk::checkbutton $frm.check_using -variable using -onvalue main -offvalue normal
grid $frm.lbl_name -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_agent_host -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_agent_host -row 1 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_agent_port -row 2 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_agent_port -row 2 -column 1 -sticky new -padx 5 -pady 5
grid $frm.lbl_port_range -row 3 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_port_range -row 3 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_safe_working_processes_memory_limit -row 4 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_safe_working_processes_memory_limit -row 4 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_safe_call_memory_limit -row 5 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_safe_call_memory_limit -row 5 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_memory_limit -row 6 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_memory_limit -row 6 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_infobases_limit -row 7 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_infobases_limit -row 7 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_connections_limit -row 8 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_connections_limit -row 8 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_cluster_port -row 9 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_cluster_port -row 9 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_dedicate_managers -row 10 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.check_dedicate_managers -row 10 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_using -row 11 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.check_using -row 11 -column 1 -sticky nw -padx 5 -pady 5
.add.frm_btn.btn_ok configure -command {
RunCommand "server insert \
--agent-host=[.add.frm.ent_agent_host get] \
--agent-port=[.add.frm.ent_agent_port get] \
--port-range=[.add.frm.ent_port_range get] \
\"--name=[regsub -all -- " " [.add.frm.ent_name get] "\\ "]\" \
--using=$using \
--infobases-limit=[.add.frm.ent_infobases_limit get] \
--memory-limit=[.add.frm.ent_memory_limit get] \
--connections-limit=[.add.frm.ent_connections_limit get] \
--cluster-port=[.add.frm.ent_cluster_port get] \
--dedicate-managers=$dedicate_managers \
--safe-working-processes-memory-limit=[.add.frm.ent_safe_working_processes_memory_limit get] \
--safe-call-memory-limit=[.add.frm.ent_safe_call_memory_limit get] \
--cluster=$active_cluster $auth $host"
Run::servers $tree $host $active_cluster
destroy .add
}
return $frm
}
proc Add::work_server {tree host values} {
return [Add::servers $tree $host $values]
}
proc Add::manager {tree host values} {
return
}
proc Add::managers {tree host values} {
return
}
proc Add::infobase {tree host values} {
return [Add::infobases $tree $host $values]
}
proc Add::infobases {tree host values} {
global default active_cluster agent_user agent_pwd cluster_user cluster_pwd auth
global security_level dbms scheduled_jobs_deny create_db license_distribution date_offset db_create
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
#set active_cluster $values
# установка значений по умолчанию
set license_distribution deny
set security_level [lindex $default(security_level) 0]
set date_offset [lindex $default(date_offset) 0]
set dbms [lindex $default(dbms) 0]
set block_shedule on
set frm [AddToplevel [::msgcat::mc "Infobase"] database_grey_64]
ttk::label $frm.lbl_name -text [::msgcat::mc "Name"]
ttk::entry $frm.ent_name
ttk::label $frm.lbl_descr -text [::msgcat::mc "Description"]
ttk::entry $frm.ent_descr
ttk::label $frm.lbl_security_level -text [::msgcat::mc "Security level"]
ttk::combobox $frm.cb_security_level -textvariable security_level -values $default(security_level)
ttk::label $frm.lbl_db_server -text [::msgcat::mc "Database server address"]
ttk::entry $frm.ent_db_server
ttk::label $frm.lbl_dbms -text [::msgcat::mc "DBMS"]
ttk::combobox $frm.cb_dbms -textvariable dbms -values $default(dbms)
ttk::label $frm.lbl_db_name -text [::msgcat::mc "Database name"]
ttk::entry $frm.ent_db_name
ttk::label $frm.lbl_db_user -text [::msgcat::mc "Database administrator"]
ttk::entry $frm.ent_db_user
ttk::label $frm.lbl_db_pwd -text [::msgcat::mc "Password"]
ttk::entry $frm.ent_db_pwd
#$frm.ent_host insert end $host
ttk::label $frm.lbl_locale -text [::msgcat::mc "Locale"]
ttk::entry $frm.ent_locale
$frm.ent_locale insert end $default(locale)
ttk::label $frm.lbl_date_offset -text [::msgcat::mc "Date offset"]
ttk::combobox $frm.cb_date_offset -textvariable date_offset -values $default(date_offset)
ttk::label $frm.lbl_license_distribution -justify left -anchor nw -text [::msgcat::mc "Management license distribution"]
ttk::checkbutton $frm.cb_license_distribution -variable license_distribution -onvalue allow -offvalue deny
ttk::label $frm.lbl_create_db -text [::msgcat::mc "Create database"]
ttk::checkbutton $frm.cb_create_db -variable create_db -onvalue true -offvalue false
ttk::label $frm.lbl_scheduled_jobs_deny -text [::msgcat::mc "Sheduled jobs deny"]
ttk::checkbutton $frm.cb_scheduled_jobs_deny -variable scheduled_jobs_deny -onvalue on -offvalue off
grid $frm.lbl_name -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 0 -column 1 -sticky new -padx 5 -pady 5
grid $frm.lbl_descr -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_descr -row 1 -column 1 -sticky new -padx 5 -pady 5
grid $frm.lbl_security_level -row 2 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_security_level -row 2 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_db_server -row 3 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_db_server -row 3 -column 1 -sticky new -padx 5 -pady 5
grid $frm.lbl_dbms -row 4 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_dbms -row 4 -column 1 -sticky new -padx 5 -pady 5
grid $frm.lbl_db_name -row 5 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_db_name -row 5 -column 1 -sticky new -padx 5 -pady 5
grid $frm.lbl_db_user -row 6 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_db_user -row 6 -column 1 -sticky new -padx 5 -pady 5
grid $frm.lbl_db_pwd -row 7 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_db_pwd -row 7 -column 1 -sticky new -padx 5 -pady 5
grid $frm.lbl_locale -row 8 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_locale -row 8 -column 1 -sticky new -padx 5 -pady 5
grid $frm.lbl_date_offset -row 9 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_date_offset -row 9 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_license_distribution -row 10 -column 0 -sticky nsew -padx 5 -pady 5
grid $frm.cb_license_distribution -row 10 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_create_db -row 11 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_create_db -row 11 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_scheduled_jobs_deny -row 12 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_scheduled_jobs_deny -row 12 -column 1 -sticky nw -padx 5 -pady 5
#set active_cluster $values
# Проверяем значение чекбокса и выставляем соответсвющую опцию
.add.frm_btn.btn_ok configure -command {
if {$create_db eq "true"} {
set db_create "--create-database"
} else {
set db_create ""
}
RunCommand "infobase create $db_create \
--name=[.add.frm.ent_name get] \
--dbms=$dbms \
--db-server=[.add.frm.ent_db_server get] \
--db-name=[.add.frm.ent_db_name get] \
--locale=[.add.frm.ent_locale get] \
--db-user=[.add.frm.ent_db_user get] \
--db-pwd=[.add.frm.ent_db_pwd get] \
--descr=[regsub -all -- " " [.add.frm.ent_descr get] "\\ "] \
--date-offset=$date_offset \
--security-level=$security_level \
--scheduled-jobs-deny=$scheduled_jobs_deny \
--license-distribution=$license_distribution \
--cluster=$active_cluster $auth $host"
Run::infobases $tree $host $active_cluster
destroy .add
}
return $frm
}
proc Add::cluster {tree host values} {
global default lifetime_limit expiration_timeout session_fault_tolerance_level
global max_memory_size max_memory_time_limit errors_count_threshold security_level
global load_balancing_mode kill_problem_processes \
agent_user agent_pwd cluster_user cluster_pwd auth_agent
if {$agent_user ne "" && $agent_pwd ne ""} {
set auth_agent "--agent-user=$agent_user --agent-pwd=$agent_pwd"
} else {
set auth_agent ""
}
set lifetime_limit $default(lifetime_limit)
set expiration_timeout $default(expiration_timeout)
set session_fault_tolerance_level $default(session_fault_tolerance_level)
set max_memory_size $default(max_memory_size)
set max_memory_time_limit $default(max_memory_time_limit)
set errors_count_threshold $default(errors_count_threshold)
set security_level [lindex $default(security_level) 0]
set load_balancing_mode [lindex $default(load_balancing_mode) 0]
set frm [AddToplevel [::msgcat::mc "Cluster"] cluster_grey_64]
ttk::label $frm.lbl_host -text [::msgcat::mc "Main server address"]
ttk::entry $frm.ent_host
ttk::label $frm.lbl_port -text [::msgcat::mc "Port"]
ttk::entry $frm.ent_port
$frm.ent_port insert end $default(port)
ttk::label $frm.lbl_name -text [::msgcat::mc "Name"]
ttk::entry $frm.ent_name
ttk::label $frm.lbl_secure_connect -text [::msgcat::mc "Secure level"]
ttk::combobox $frm.cb_security_level -textvariable security_level -values $default(security_level)
ttk::label $frm.lbl_expiration_timeout -text [::msgcat::mc "Forced termination time"]
ttk::entry $frm.ent_expiration_timeout -textvariable expiration_timeout
ttk::label $frm.lbl_session_fault_tolerance_level -text [::msgcat::mc "Fault-tolerance level"]
ttk::entry $frm.ent_session_fault_tolerance_level -textvariable session_fault_tolerance_level
ttk::label $frm.lbl_load_balancing_mode -text [::msgcat::mc "Load balancing mode"]
ttk::combobox $frm.cb_load_balancing_mode -textvariable load_balancing_mode \
-values $default(load_balancing_mode)
ttk::label $frm.lbl_errors_count_threshold -text [::msgcat::mc "Server errors threshold"]
ttk::entry $frm.ent_errors_count_threshold -textvariable errors_count_threshold
ttk::label $frm.lbl_processes -text [::msgcat::mc "Working process"]
ttk::label $frm.lbl_lifetime_limit -text [::msgcat::mc "Restart time"]
ttk::entry $frm.ent_lifetime_limit -textvariable lifetime_limit
ttk::label $frm.lbl_max_memory_size -text [::msgcat::mc "Maximum virtual address space"]
ttk::entry $frm.ent_max_memory_size -textvariable max_memory_size
ttk::label $frm.lbl_max_memory_time_limit -text [::msgcat::mc "Maximum period of memori size exeeding"]
ttk::entry $frm.ent_max_memory_time_limit -textvariable max_memory_time_limit
ttk::label $frm.lbl_kill_problem_processes -justify left -anchor nw -text [::msgcat::mc "Terminate corrupted processes"]
ttk::checkbutton $frm.check_kill_problem_processes -variable kill_problem_processes -onvalue yes -offvalue no
grid $frm.lbl_host -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_host -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_port -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_port -row 1 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_name -row 2 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 2 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_secure_connect -row 3 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_security_level -row 3 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_expiration_timeout -row 4 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_expiration_timeout -row 4 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_session_fault_tolerance_level -row 5 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_session_fault_tolerance_level -row 5 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_load_balancing_mode -row 6 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_load_balancing_mode -row 6 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_errors_count_threshold -row 7 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_errors_count_threshold -row 7 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_processes -row 8 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.lbl_lifetime_limit -row 9 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_lifetime_limit -row 9 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_max_memory_size -row 10 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_max_memory_size -row 10 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_max_memory_time_limit -row 11 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_max_memory_time_limit -row 11 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_kill_problem_processes -row 12 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.check_kill_problem_processes -row 12 -column 1 -sticky nw -padx 5 -pady 5
.add.frm_btn.btn_ok configure -command {
RunCommand "cluster insert \
--host=[.add.frm.ent_host get] \
--port=[.add.frm.ent_port get] \
--name=[.add.frm.ent_name get] \
--expiration-timeout=$expiration_timeout \
--lifetime-limit=$lifetime_limit \
--max-memory-size=$max_memory_size \
--max-memory-time-limit=$max_memory_time_limit \
--security-level=$security_level \
--session-fault-tolerance-level=$session_fault_tolerance_level \
--load-balancing-mode=$load_balancing_mode \
--errors-count-threshold=$errors_count_threshold \
--kill-problem-processes=$kill_problem_processes \
$auth_agent $host"
Run::server $tree $host ""
destroy .add
}
return $frm
}
proc Add::rule {tree host values} {
global default active_cluster infobase object_type server infobase_name rule_type \
agent_user agent_pwd cluster_user cluster_pwd auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set server $values
set frm [AddToplevel [::msgcat::mc "Assignment rule"] functional_grey_64]
#set type [lindex $default(obtype) 0]
set infobase_name ""
ttk::label $frm.lbl_object_type -text [::msgcat::mc "Object type"]
ttk::combobox $frm.cb_object_type -textvariable object_type \
-values $default(object_type)
ttk::label $frm.lbl_rule_type -text [::msgcat::mc "Rule type"]
ttk::combobox $frm.cb_rule_type -textvariable rule_type \
-values $default(rule_type)
ttk::label $frm.lbl_infobase_name -text [::msgcat::mc "Infobase"]
ttk::combobox $frm.cb_infobase_name -textvariable infobase_name \
-values [GetInfobases $active_cluster $host]
ttk::label $frm.lbl_application_ext -text [::msgcat::mc "Application with an ajustment"]
ttk::entry $frm.ent_application_ext
ttk::label $frm.lbl_priority -text [::msgcat::mc "Priority"]
ttk::entry $frm.ent_priority
$frm.ent_priority insert end $default(priority)
grid $frm.lbl_object_type -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_object_type -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_rule_type -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_rule_type -row 1 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_infobase_name -row 2 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_infobase_name -row 2 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_application_ext -row 3 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_application_ext -row 3 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_priority -row 4 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_priority -row 4 -column 1 -sticky nsew -padx 5 -pady 5
.add.frm_btn.btn_ok configure -command {
RunCommand "rule insert \
--cluster=$active_cluster $auth \
--server=$server \
--position=0 \
--object-type=$object_type \
--infobase-name=$infobase_name \
--rule-type=$rule_type \
--application-ext=[.add.frm.ent_application_ext get] \
--priority=[.add.frm.ent_priority get] $host"
Run::rule $tree $host $server
destroy .add
}
return $frm
}
proc Add::profiles {tree host values} {
Add::profile $tree $host $values
}
proc Add::profile {tree host values} {
global default active_cluster server agent_user agent_pwd cluster_user cluster_pwd auth
global config priv crypto right_extension right_extension_definition_roles \
all_modules_extension modules_available_for_extension modules_not_available_for_extension
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set var_list {config priv crypto right_extension all_modules_extension }
foreach v $var_list {
set $v "off"
}
set var_list {right_extension_definition_roles modules_available_for_extension modules_not_available_for_extension}
foreach v $var_list {
set $v 0
}
unset var_list
set frm [AddToplevel [::msgcat::mc "Security profile"] security_grey_64]
ttk::label $frm.lbl_name -text [::msgcat::mc "Name"]
ttk::entry $frm.ent_name
ttk::label $frm.lbl_descr -text [::msgcat::mc "Description"]
ttk::entry $frm.ent_descr
ttk::label $frm.lbl_config -justify left -anchor nw \
-text [::msgcat::mc "Using the security profile from the configuration"]
ttk::checkbutton $frm.check_config -variable config -onvalue yes -offvalue no
ttk::label $frm.lbl_priv -justify left -anchor nw \
-text [::msgcat::mc "Priveleged mode"]
ttk::checkbutton $frm.check_priv -variable priv -onvalue yes -offvalue no
ttk::label $frm.lbl_crypto -justify left -anchor nw \
-text [::msgcat::mc "Using cryptography function"]
ttk::checkbutton $frm.check_crypto -variable crypto -onvalue yes -offvalue no
ttk::label $frm.lbl_right_extension -justify left -anchor nw \
-text [::msgcat::mc "All access right extention"]
ttk::checkbutton $frm.check_right_extension \
-variable right_extension -onvalue yes -offvalue no
ttk::label $frm.lbl_right_extension_definition_roles -justify left -anchor nw \
-text [::msgcat::mc "Roles that restrict access rights"]
ttk::combobox $frm.cb_right_extension_definition_roles \
-textvariable right_extension_definition_roles
ttk::label $frm.lbl_all_modules_extension -justify left -anchor nw \
-text [::msgcat::mc "Allow extention of all modules"]
ttk::checkbutton $frm.check_all_modules_extension \
-variable all_modules_extension -onvalue yes -offvalue no
ttk::label $frm.lbl_modules_available_for_extension \
-text [::msgcat::mc "Modules available for extention"]
ttk::combobox $frm.cb_modules_available_for_extension \
-textvariable modules_available_for_extension
ttk::label $frm.lbl_modules_not_available_for_extension \
-text [::msgcat::mc "Modules not available for extention"]
ttk::combobox $frm.cb_modules_not_available_for_extension \
-textvariable modules_not_available_for_extension
grid $frm.lbl_name -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_descr -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_descr -row 1 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_config -row 2 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.check_config -row 2 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_priv -row 3 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.check_priv -row 3 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_crypto -row 4 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.check_crypto -row 4 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_right_extension -row 5 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.check_right_extension -row 5 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_right_extension_definition_roles -row 6 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_right_extension_definition_roles -row 6 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_all_modules_extension -row 7 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.check_all_modules_extension -row 7 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_modules_available_for_extension -row 8 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_modules_available_for_extension -row 8 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_modules_not_available_for_extension -row 9 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_modules_not_available_for_extension -row 9 -column 1 -sticky nsew -padx 5 -pady 5
.add.frm_btn.btn_ok configure -command {
RunCommand "profile update \
--cluster=$active_cluster $auth \
--name=[regsub -all -- " " [.add.frm.ent_name get] "_"] \
--descr=[regsub -all -- " " [.add.frm.ent_descr get] "\\ "] \
--config=$config \
--priv=$priv \
--crypto=$crypto \
--right-extension=$right_extension \
--right-extension-definition-roles=$right_extension_definition_roles \
--all-modules-extension=$all_modules_extension \
--modules-available-for-extension=$modules_available_for_extension \
--modules-not-available-for-extension=$modules_not_available_for_extension \
$host"
Run::profiles $tree $host $active_cluster
destroy .add
}
return $frm
}
proc Add::directory {tree host values} {
global default active_cluster profile_name agent_user agent_pwd cluster_user cluster_pwd auth
global
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set var_list {allowedRead allowedWrite}
foreach v $var_list {
set $v "no"
}
unset var_list
set frm [AddToplevel [::msgcat::mc "Virtual directory"] directory_grey_64]
ttk::label $frm.lbl_alias -text [::msgcat::mc "Logical URL"]
ttk::entry $frm.ent_alias
ttk::label $frm.lbl_descr -text [::msgcat::mc "Description"]
ttk::entry $frm.ent_descr
ttk::label $frm.lbl_physicalPath -justify left -anchor nw -text [::msgcat::mc "Phisical path"]
ttk::entry $frm.ent_physicalPath
ttk::label $frm.lbl_allowedRead -justify left -anchor nw -text [::msgcat::mc "Reading is allowed"]
ttk::checkbutton $frm.check_allowedRead -variable allowedRead -onvalue yes -offvalue no
ttk::label $frm.lbl_allowedWrite -justify left -anchor nw -text [::msgcat::mc "Write is allowed"]
ttk::checkbutton $frm.check_allowedWrite -variable allowedWrite -onvalue yes -offvalue no
grid $frm.lbl_alias -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_alias -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_descr -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_descr -row 1 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_physicalPath -row 2 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_physicalPath -row 2 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_allowedRead -row 3 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.check_allowedRead -row 3 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_allowedWrite -row 4 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.check_allowedWrite -row 4 -column 1 -sticky nw -padx 5 -pady 5
.add.frm_btn.btn_ok configure -command {
RunCommand "profile --cluster=$active_cluster $auth \
acl --name=$profile_name \
directory update \
\"--alias=[regsub -all -- " " [.add.frm.ent_alias get] "\\ "]\" \
\"--descr=[regsub -all -- " " [.add.frm.ent_descr get] "\\ "]\" \
\"--physicalPath=[regsub -all -- " " [.add.frm.ent_physicalPath get] "\\ "]\" \
--allowedRead=$allowedRead \
--allowedWrite=$allowedWrite \
$host"
Run::directory $tree $host $profile_name
destroy .add
}
return $frm
}
proc Add::addin {tree host values} {
global default active_cluster profile_name agent_user agent_pwd cluster_user cluster_pwd auth
global
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set var_list {allowedRead allowedWrite}
foreach v $var_list {
set $v "no"
}
unset var_list
set frm [AddToplevel [::msgcat::mc "Available add-in"] addin_grey_64]
ttk::label $frm.lbl_name -text [::msgcat::mc "Name"]
ttk::entry $frm.ent_name
ttk::label $frm.lbl_descr -text [::msgcat::mc "Description"]
ttk::entry $frm.ent_descr
ttk::label $frm.lbl_hash -justify left -anchor nw -text [::msgcat::mc "Check summ"]
ttk::entry $frm.ent_hash
grid $frm.lbl_name -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_descr -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_descr -row 1 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_hash -row 2 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_hash -row 2 -column 1 -sticky nw -padx 5 -pady 5
.add.frm_btn.btn_ok configure -command {
RunCommand "profile --cluster=$active_cluster $auth \
acl --name=$profile_name \
addin update \
\"--name=[regsub -all -- " " [.add.frm.ent_name get] "\\ "]\" \
\"--descr=[regsub -all -- " " [.add.frm.ent_descr get] "\\ "]\" \
--hash=[.add.frm.ent_hash get] \
$host"
Run::addin $tree $host $profile_name
destroy .add
}
return $frm
}
proc Add::module {tree host values} {
global default active_cluster profile_name agent_user agent_pwd cluster_user cluster_pwd auth
global
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set var_list {allowedRead allowedWrite}
foreach v $var_list {
set $v "no"
}
unset var_list
set frm [AddToplevel [::msgcat::mc "External module"] module_grey_64]
ttk::label $frm.lbl_name -text [::msgcat::mc "Name"]
ttk::entry $frm.ent_name
ttk::label $frm.lbl_descr -text [::msgcat::mc "Description"]
ttk::entry $frm.ent_descr
ttk::label $frm.lbl_hash -justify left -anchor nw -text [::msgcat::mc "Check summ"]
ttk::entry $frm.ent_hash
grid $frm.lbl_name -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_descr -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_descr -row 1 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_hash -row 2 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_hash -row 2 -column 1 -sticky nw -padx 5 -pady 5
.add.frm_btn.btn_ok configure -command {
RunCommand "profile --cluster=$active_cluster $auth \
acl --name=$profile_name \
module update \
\"--name=[regsub -all -- " " [.add.frm.ent_name get] "\\ "]\" \
\"--descr=[regsub -all -- " " [.add.frm.ent_descr get] "\\ "]\" \
--hash=[.add.frm.ent_hash get] \
$host"
Run::module $tree $host $profile_name
destroy .add
}
return $frm
}
proc Add::com {tree host values} {
global default active_cluster profile_name agent_user agent_pwd cluster_user cluster_pwd auth
global
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set var_list {allowedRead allowedWrite}
foreach v $var_list {
set $v "no"
}
unset var_list
set frm [AddToplevel [::msgcat::mc "COM class"] com_grey_64]
ttk::label $frm.lbl_name -text [::msgcat::mc "Name"]
ttk::entry $frm.ent_name
ttk::label $frm.lbl_descr -text [::msgcat::mc "Description"]
ttk::entry $frm.ent_descr
ttk::label $frm.lbl_fileName -justify left -anchor nw -text [::msgcat::mc "Moniker file name"]
ttk::entry $frm.ent_fileName
ttk::label $frm.lbl_id -justify left -anchor nw -text [::msgcat::mc "COM class ID"]
ttk::entry $frm.ent_id
ttk::label $frm.lbl_host -justify left -anchor nw -text [::msgcat::mc "COM object computer"]
ttk::entry $frm.ent_host
grid $frm.lbl_name -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_descr -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_descr -row 1 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_fileName -row 2 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_fileName -row 2 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_id -row 3 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_id -row 3 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_host -row 4 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_host -row 4 -column 1 -sticky nw -padx 5 -pady 5
.add.frm_btn.btn_ok configure -command {
RunCommand "profile --cluster=$active_cluster $auth \
acl --name=$profile_name com update \
\"--name=[regsub -all -- " " [.add.frm.ent_name get] "\\ "]\" \
\"--descr=[regsub -all -- " " [.add.frm.ent_descr get] "\\ "]\" \
\"--fileName=[regsub -all -- " " [.add.frm.ent_fileName get] "\\ "]\" \
--id=[.add.frm.ent_id get] \
--host=[.add.frm.ent_host get] \
$host"
Run::com $tree $host $profile_name
destroy .add
}
return $frm
}
proc Add::app {tree host values} {
global default active_cluster profile_name agent_user agent_pwd cluster_user cluster_pwd auth
global
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set var_list {allowedRead allowedWrite}
foreach v $var_list {
set $v "no"
}
unset var_list
set frm [AddToplevel [::msgcat::mc "Application"] app_grey_64]
ttk::label $frm.lbl_name -text [::msgcat::mc "Name"]
ttk::entry $frm.ent_name
ttk::label $frm.lbl_descr -text [::msgcat::mc "Description"]
ttk::entry $frm.ent_descr
ttk::label $frm.lbl_wild -justify left -anchor nw -text [::msgcat::mc "Aplication command line sintax"]
ttk::entry $frm.ent_wild
grid $frm.lbl_name -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_descr -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_descr -row 1 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_wild -row 2 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_wild -row 2 -column 1 -sticky nw -padx 5 -pady 5
.add.frm_btn.btn_ok configure -command {
RunCommand "profile --cluster=$active_cluster $auth \
acl --name=$profile_name app update \
\"--name=[regsub -all -- " " [.add.frm.ent_name get] "\\ "]\" \
\"--descr=[regsub -all -- " " [.add.frm.ent_descr get] "\\ "]\" \
\"--wild=[regsub -all -- " " [.add.frm.ent_wild get] "\\ "]\" \
$host"
Run::app $tree $host $profile_name
destroy .add
}
return $frm
}
proc Add::inet {tree host values} {
global default active_cluster profile_name agent_user agent_pwd cluster_user cluster_pwd auth
global
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set var_list {allowedRead allowedWrite}
foreach v $var_list {
set $v "no"
}
unset var_list
set frm [AddToplevel [::msgcat::mc "Internet resource"] link_grey_64]
ttk::label $frm.lbl_name -text [::msgcat::mc "Name"]
ttk::entry $frm.ent_name
ttk::label $frm.lbl_descr -text [::msgcat::mc "Description"]
ttk::entry $frm.ent_descr
ttk::label $frm.lbl_protocol -justify left -anchor nw -text [::msgcat::mc "Protocol"]
ttk::entry $frm.ent_protocol
ttk::label $frm.lbl_url -justify left -anchor nw -text [::msgcat::mc "Address (URL)"]
ttk::entry $frm.ent_url
ttk::label $frm.lbl_port -justify left -anchor nw -text [::msgcat::mc "Port"]
ttk::entry $frm.ent_port
$frm.ent_port insert end 0
grid $frm.lbl_name -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_descr -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_descr -row 1 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_protocol -row 2 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_protocol -row 2 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_url -row 3 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_url -row 3 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_port -row 4 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_port -row 4 -column 1 -sticky nw -padx 5 -pady 5
.add.frm_btn.btn_ok configure -command {
RunCommand "profile --cluster=$active_cluster $auth \
acl --name=$profile_name inet update \
\"--name=[regsub -all -- " " [.add.frm.ent_name get] "\\ "]\" \
\"--descr=[regsub -all -- " " [.add.frm.ent_descr get] "\\ "]\" \
--protocol=[.add.frm.ent_protocol get] \
\"--url=[regsub -all -- " " [.add.frm.ent_url get] "\\ "]\" \
--port=[.add.frm.ent_port get] \
$host"
Run::inet $tree $host $profile_name
destroy .add
}
return $frm
}
proc Add::connections {tree host values} {return}
proc Add::processes {tree host values} {return}
proc Add::locks {tree host values} {return}
proc Add::sessions {tree host values} {return}
proc Edit {} {
global active_cluster host
set tree .frm_tree.tree
set id [.frm_tree.tree selection]
set values [.frm_tree.tree item $id -values]
set key [lindex [split $id "::"] 0]
#puts $key
#puts $values
if {$values eq "" || $key eq ""} {return}
Edit::$key $tree $host $values
}
namespace eval Edit {} {}
proc Edit::admins {tree host value} {
return
}
proc Edit::manager {tree host values} {
return
}
proc Edit::managers {tree host values} {
return
}
proc Edit::server {tree host value} {
global dir prev_address rac_cmd rac_cmd_for_host
set frm [Add::server]
wm title .add [::msgcat::mc "Edit record"]
set lst [split $value ":"]
set prev_address $value
set orig_file [open [file join $dir(work) 1c_srv.cfg] "r"]
while {[gets $orig_file line] >=0 } {
if [string match "$prev_address*" $line] {
set path_to_rac [string trim [lindex [split $line ","] 1]]
if {$path_to_rac eq ""} {
set path_to_rac "$rac_cmd"
}
}
}
close $orig_file
.add.frm.ent_host delete 0 end
.add.frm.ent_port delete 0 end
.add.frm.ent_path_to_rac delete 0 end
.add.frm.ent_host insert end [lindex $lst 0]
.add.frm.ent_port insert end [lindex $lst 1]
.add.frm.ent_path_to_rac insert end $path_to_rac
.add.frm_btn.btn_ok configure -command {
set host "[.add.frm.ent_host get]:[.add.frm.ent_port get]"
#set rac_cmd [.add.frm.ent_path_to_rac get]
set rac_cmd_for_host($host) [.add.frm.ent_path_to_rac get]
.frm_tree.tree delete "server::$prev_address"
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
.frm_tree.tree insert {} end -id "server::$host" -text "$host" -values "$host"
if [file exists [file join $dir(work) 1c_srv.cfg.bak]] {
file delete [file join $dir(work) 1c_srv.cfg.bak]
}
file copy [file join $dir(work) 1c_srv.cfg] [file join $dir(work) 1c_srv.cfg.bak]
set orig_file [open [file join $dir(work) 1c_srv.cfg.bak] "r"]
set file [open [file join $dir(work) 1c_srv.cfg] "w"]
while {[gets $orig_file line] >=0 } {
if [string match "$prev_address*" $line] {
puts $file "$host,$rac_cmd_for_host($host)"
} else {
puts $file $line
}
}
close $file
close $orig_file
#return "$host:$port"
file delete [file join $dir(work) 1c_srv.cfg.bak]
destroy .add
return $host
}
}
proc Edit::cluster {tree host values} {
global default lifetime_limit expiration_timeout session_fault_tolerance_level
global max_memory_size max_memory_time_limit errors_count_threshold security_level
global load_balancing_mode kill_problem_processes active_cluster \
agent_user agent_pwd cluster_user cluster_pwd auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set frm [Add::cluster $tree $host $values]
wm title .add [::msgcat::mc "Edit record"]
$frm configure -text [::msgcat::mc "Cluster"]
set active_cluster $values
set lst [RunCommand "cluster info --cluster=$active_cluster $host"]
FormFieldsDataInsert $frm $lst
$frm.ent_host configure -state disable
$frm.ent_port configure -state disable
.add.frm_btn.btn_ok configure -command {
RunCommand "cluster update \
--cluster=$active_cluster $auth \
--name=[.add.frm.ent_name get] \
--expiration-timeout=$expiration_timeout \
--lifetime-limit=$lifetime_limit \
--max-memory-size=$max_memory_size \
--max-memory-time-limit=$max_memory_time_limit \
--security-level=$security_level \
--session-fault-tolerance-level=$session_fault_tolerance_level \
--load-balancing-mode=$load_balancing_mode \
--errors-count-threshold=$errors_count_threshold \
--kill-problem-processes=$kill_problem_processes \
$auth $host"
$tree delete "cluster::$active_cluster"
Run::server $tree $host ""
destroy .add
}
}
proc Edit::infobases {tree host values} {
set infobase [GetWorkTreeItems "infobase"]
if {[info exists infobase] == 0 || $infobase eq ""} {
return
}
Edit::infobase $tree $host $infobase
}
proc Edit::infobase {tree host values} {
global default active_cluster infobase agent_user agent_pwd cluster_user cluster_pwd
global security_level dbms scheduled_jobs_deny license_distribution date_offset
global sessions_deny auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set infobase $values
set frm [Add::infobases $tree $host $values]
wm title .add [::msgcat::mc "Edit record"]
$frm.lbl_create_db configure -state disable
$frm.cb_create_db configure -state disable
$frm.lbl_locale configure -state disable
$frm.ent_locale configure -state disable
$frm configure -text [::msgcat::mc "Infobase"]
#set active_cluster $values
ttk::label $frm.lbl_denied_from \
-text [::msgcat::mc "Start of the time interval within which\nthe session lock mode is enabled"] \
-justify left -anchor nw
ttk::entry $frm.ent_denied_from
ttk::label $frm.lbl_denied_message \
-text [::msgcat::mc "Message displayed upon session lock violation"] \
-justify left -anchor nw
ttk::entry $frm.ent_denied_message
ttk::label $frm.lbl_denied_parameter \
-text [::msgcat::mc "Session lock parameter"]
ttk::entry $frm.ent_denied_parameter
ttk::label $frm.lbl_denied_to \
-text [::msgcat::mc "End of the time interval within which\nthe session lock mode is enabled"] \
-justify left -anchor nw
ttk::entry $frm.ent_denied_to
ttk::label $frm.lbl_permission_code \
-text [::msgcat::mc "Permission code that allows the session\nto start in spite of enabled session lock"] \
-justify left -anchor nw
ttk::entry $frm.ent_permission_code
ttk::label $frm.lbl_external_session_manager_connection_string \
-text [::msgcat::mc "External session management parameter"]
ttk::entry $frm.ent_external_session_manager_connection_string
ttk::label $frm.lbl_security_profile \
-text [::msgcat::mc "Infobase security profile"]
ttk::entry $frm.ent_security_profile
ttk::label $frm.lbl_safe_mode_security_profile_name \
-text [::msgcat::mc "External code security profile"]
ttk::entry $frm.ent_safe_mode_security_profile_name
ttk::label $frm.lbl_sessions_deny \
-text [::msgcat::mc "Session lock mode management"]
ttk::checkbutton $frm.check_sessions_deny \
-variable sessions_deny -onvalue on -offvalue off
ttk::label $frm.lbl_external_session_manager_required \
-text [::msgcat::mc "External session management required"]
ttk::checkbutton $frm.check_external_session_manager_required \
-variable external_session_manager_required -onvalue yes -offvalue no
grid $frm.lbl_denied_from -row 0 -column 2 -sticky nsw -padx 5 -pady 5
grid $frm.ent_denied_from -row 0 -column 3 -sticky nw -padx 5 -pady 5
grid $frm.lbl_denied_message -row 1 -column 2 -sticky nsw -padx 5 -pady 5
grid $frm.ent_denied_message -row 1 -column 3 -sticky nw -padx 5 -pady 5
grid $frm.lbl_denied_parameter -row 2 -column 2 -sticky nw -padx 5 -pady 5
grid $frm.ent_denied_parameter -row 2 -column 3 -sticky nw -padx 5 -pady 5
grid $frm.lbl_denied_to -row 3 -column 2 -sticky nsw -padx 5 -pady 5
grid $frm.ent_denied_to -row 3 -column 3 -sticky nw -padx 5 -pady 5
grid $frm.lbl_permission_code -row 4 -column 2 -sticky nsw -padx 5 -pady 5
grid $frm.ent_permission_code -row 4 -column 3 -sticky nw -padx 5 -pady 5
grid $frm.lbl_external_session_manager_connection_string \
-row 5 -column 2 -sticky nw -padx 5 -pady 5
grid $frm.ent_external_session_manager_connection_string \
-row 5 -column 3 -sticky nw -padx 5 -pady 5
grid $frm.lbl_security_profile -row 6 -column 2 -sticky nw -padx 5 -pady 5
grid $frm.ent_security_profile -row 6 -column 3 -sticky nw -padx 5 -pady 5
grid $frm.lbl_safe_mode_security_profile_name -row 7 -column 2 -sticky nw -padx 5 -pady 5
grid $frm.ent_safe_mode_security_profile_name -row 7 -column 3 -sticky nw -padx 5 -pady 5
grid $frm.lbl_sessions_deny -row 8 -column 2 -sticky nw -padx 5 -pady 5
grid $frm.check_sessions_deny -row 8 -column 3 -sticky nw -padx 5 -pady 5
grid $frm.lbl_external_session_manager_required -row 9 -column 2 -sticky nw -padx 5 -pady 5
grid $frm.check_external_session_manager_required -row 9 -column 3 -sticky nw -padx 5 -pady 5
set lst [RunCommand "infobase info --cluster=$active_cluster --infobase=$values $auth $host"]
FormFieldsDataInsert $frm $lst
.add.frm_btn.btn_ok configure -command {
RunCommand "infobase update \
--infobase=$infobase \
--infobase-user= \
--infobase-pwd= \
--dbms=$dbms \
--db-server=[.add.frm.ent_db_server get] \
--db-name=[.add.frm.ent_db_name get] \
--db-user=[.add.frm.ent_db_user get] \
--db-pwd=[.add.frm.ent_db_pwd get] \
--descr=[regsub -all -- " " [.add.frm.ent_descr get] "\\ "]\
--denied-from=[.add.frm.ent_denied_from get] \
--denied-message=[regsub -all -- " " [.add.frm.ent_denied_message get] "\\ "]\
--denied-parameter=[regsub -all -- " " [.add.frm.ent_denied_parameter get] "\\ "]\
--denied-to=[.add.frm.ent_denied_to get] \
--permission-code=[regsub -all -- " " [.add.frm.ent_permission_code get] "\\ "]\
--sessions-deny=$sessions_deny \
--scheduled-jobs-deny=$scheduled_jobs_deny \
--license-distribution=$license_distribution \
--external-session-manager-connection-string=[.add.frm.ent_external_session_manager_connection_string get] \
--external-session-manager-required=$external_session_manager_required \
--security-profile-name=[.add.frm.ent_security_profile get] \
--safe-mode-security-profile-name=[.add.frm.ent_safe_mode_security_profile_name get] \
--cluster=$active_cluster $auth $host"
#Run::infobases $tree $host $active_cluster
destroy .add
}
}
proc Edit::servers {tree host values} {
set work_server [GetWorkTreeItems "server"]
if {[info exists work_server] == 0 || $work_server eq ""} {
return
}
Edit::work_server $tree $host $work_server
}
proc Edit::work_server {tree host values} {
global default active_cluster agent_user agent_pwd cluster_user cluster_pwd
global default dedicate_managers using auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set server $values
set frm [Add::work_server $tree $host $values]
wm title .add [::msgcat::mc "Edit record"]
$frm configure -text [::msgcat::mc "Work server"]
set lst [RunCommand "server info --cluster=$active_cluster $auth --server=$server $host"]
FormFieldsDataInsert $frm $lst
$frm.lbl_agent_port configure -state disable
$frm.ent_agent_port configure -state disable
$frm.lbl_port_range configure -state disable
$frm.ent_port_range configure -state disable
$frm.lbl_name configure -state disable
$frm.ent_name configure -state disable
$frm.lbl_cluster_port configure -state disable
$frm.ent_cluster_port configure -state disable
.add.frm_btn.btn_ok configure -command {
RunCommand "server update \
--server=$server \
--using=$using \
--infobases-limit=[.add.frm.ent_infobases_limit get] \
--memory-limit=[.add.frm.ent_memory_limit get] \
--connections-limit=[.add.frm.ent_connections_limit get] \
--dedicate-managers=$dedicate_managers \
--safe-working-processes-memory-limit=[.add.frm.ent_safe_working_processes_memory_limit get] \
--safe-call-memory-limit=[.add.frm.ent_safe_call_memory_limit get] \
--cluster=$active_cluster $auth $host"
Run::servers $tree $host $active_cluster
destroy .add
}
}
proc Edit::rule {tree host values} {
global default active_cluster object_type infobase_name object_type server infobase_name rule_type rule \
agent_user agent_pwd cluster_user cluster_pwd auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set rule [GetWorkTreeItems "rule"]
if {[info exists rule] == 0 || $rule eq ""} {
return
}
set frm [Add::rule $tree $host $server]
wm title .add [::msgcat::mc "Edit record"]
$frm configure -text [::msgcat::mc "Assignment rule"]
set lst [RunCommand "rule info --cluster=$active_cluster $auth --server=$server --rule=$rule $host"]
FormFieldsDataInsert $frm $lst
.add.frm_btn.btn_ok configure -command {
RunCommand "rule update \
--cluster=$active_cluster $auth \
--server=$server \
--rule=$rule \
--position=0 \
--object-type=$object_type \
--infobase-name=$infobase_name \
--rule-type=$rule_type \
--application-ext=[.add.frm.ent_application_ext get] \
--priority=[.add.frm.ent_priority get] $host"
Run::rule $tree $host $server
destroy .add
}
}
proc Edit::profile {tree host values} {
global default active_cluster server agent_user agent_pwd cluster_user cluster_pwd auth
global config priv crypto right_extension right_extension_definition_roles \
all_modules_extension modules_available_for_extension modules_not_available_for_extension
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set lst [GetWorkTreeRow]
if {$lst eq ""} {
return
}
set frm [Add::profile $tree $host $values]
wm title .add [::msgcat::mc "Edit record"]
$frm configure -text "[::msgcat::mc "Security profile"]: $values"
set work_tree_id [.frm_work.tree_work selection]
puts "$work_tree_id"
set work_tree_values_list [.frm_work.tree_work item $work_tree_id -values]
set column_list [.frm_work.tree_work cget -columns]
set l1 [llength $column_list]
set l2 [llength $work_tree_values_list]
if {$l1 == $l2} {
for {set i 0} {$i <= $l1 } {incr i} {
lappend lst "[lindex $column_list $i] : [lindex $work_tree_values_list $i]"
}
} else {
return
}
FormFieldsDataInsert $frm [list $lst]
.add.frm.ent_name configure -state disable
.add.frm_btn.btn_ok configure -command {
RunCommand "profile update \
--cluster=$active_cluster $auth \
\"--name=[regsub -all -- " " [.add.frm.ent_name get] "\\ "]\" \
\"--descr=[regsub -all -- " " [.add.frm.ent_descr get] "\\ "]\" \
--config=$config \
--priv=$priv \
--crypto=$crypto \
--right-extension=$right_extension \
--right-extension-definition-roles=$right_extension_definition_roles \
--all-modules-extension=$all_modules_extension \
--modules-available-for-extension=$modules_available_for_extension \
--modules-not-available-for-extension=$modules_not_available_for_extension \
$host"
Run::profiles $tree $host $active_cluster
destroy .add
}
}
proc Edit::profiles {tree host values} {
#return
Edit::profile $tree $host $values
}
proc Edit::directory {tree host values} {
global default active_cluster profile_name \
agent_user agent_pwd cluster_user cluster_pwd auth
set lst [GetWorkTreeRow]
set frm [Add::directory $tree $host $profile_name]
wm title .add [::msgcat::mc "Edit record"]
$frm configure -text [::msgcat::mc "Virtual directory"]
FormFieldsDataInsert $frm [list $lst]
$frm.ent_alias configure -state disable
}
proc Edit::addin {tree host values} {
Edit::acl $tree $host addin "Available add-in"
}
proc Edit::module {tree host values} {
Edit::acl $tree $host module "External module"
}
proc Edit::com {tree host values} {
Edit::acl $tree $host com "COM class"
}
proc Edit::app {tree host values} {
Edit::acl $tree $host app "Application"
}
proc Edit::inet {tree host values} {
Edit::acl $tree $host inet "Internet resource"
}
proc Edit::acl {tree host item descr} {
global default active_cluster profile_name \
agent_user agent_pwd cluster_user cluster_pwd auth
set lst [GetWorkTreeRow]
if {$lst eq ""} {
return
}
set frm [Add::$item $tree $host $profile_name]
wm title .add [::msgcat::mc "Edit record"]
$frm configure -text [::msgcat::mc $descr]
FormFieldsDataInsert $frm [list $lst]
$frm.ent_name configure -state disable
}
proc Edit::connections {tree host values} {return}
proc Edit::processes {tree host values} {return}
proc Edit::locks {tree host values} {return}
proc Edit::sessions {tree host values} {return}
proc Del {} {
global active_cluster host
set tree .frm_tree.tree
set id [.frm_tree.tree selection]
set values [.frm_tree.tree item $id -values]
set key [lindex [split $id "::"] 0]
if {$values eq "" || $key eq ""} {return}
Del::$key $tree $host $values
}
namespace eval Del {} {}
proc Del::manager {tree host values} {
return
}
proc Del::managers {tree host values} {
return
}
proc Del::locks {tree host values} {
return
}
proc Del::processes {tree host values} {
return
}
proc Del::admin {tree host values} {
global active_cluster agent_user agent_pwd cluster_user cluster_pwd auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
if {$agent_user ne "" && $agent_pwd ne ""} {
set agent_auth "--agent-user=$agent_user --agent-pwd=$agent_pwd"
} else {
set agent_auth ""
}
set answer [tk_messageBox -message "[::msgcat::mc "Delete addministrator"] $values?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand "cluster admin remove --name=$values --cluster=$active_cluster $auth $host"]
#.frm_tree.tree delete "admin::$values"
set cluster_user ""
set cluster_pwd ""
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
}
no {return}
}
}
proc Del::admins {tree host values} {
Del::admin $tree $host [GetWorkTreeItems "name"]
}
proc Del::agent_admin {tree host values} {
global agent_user agent_pwd auth
if {$agent_user ne "" && $agent_pwd ne ""} {
set agent_auth "--agent-user=$agent_user --agent-pwd=$agent_pwd"
} else {
set agent_auth ""
}
set answer [tk_messageBox -message "[::msgcat::mc "Delete addministrator"] $values?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand "agent admin remove --name=$values $agent_auth $host"]
#.frm_tree.tree delete "admin::$values"
set agent_user ""
set agent_pwd ""
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
}
no {return}
}
}
proc Del::agent_admins {tree host values} {
Del::agent_admin $tree $host [GetWorkTreeItems "name"]
}
proc Del::work_server {tree host values} {
global active_cluster agent_user agent_pwd cluster_user cluster_pwd auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set answer [tk_messageBox -message "[::msgcat::mc "Delete work server"] $values?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand "server remove --cluster=$active_cluster $auth --server=$values $host"]
.frm_tree.tree delete "work_server::$values"
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
}
no {return}
}
}
proc Del::servers {tree host values} {
Del::work_server $tree $host [GetWorkTreeItems "server"]
}
proc Del::cluster {tree host values} {
global agent_user agent_pwd cluster_user cluster_pwd auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set answer [tk_messageBox -message "[::msgcat::mc "Delete cluster"] $values?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand "cluster remove --cluster=$values $auth $host"]
$tree delete "cluster::$values"
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
}
no {return}
}
}
proc Del::infobase {tree host values} {
global active_cluster agent_user agent_pwd cluster_user cluster_pwd auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set answer [tk_messageBox -message "[::msgcat::mc "Delete infobase"] $values?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand "infobase drop --infobase=$values --cluster=$active_cluster $auth $host"]
$tree delete "infobase::$values"
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
}
no {return}
}
}
proc Del::infobases {tree host values} {
Del::infobase $tree $host [GetWorkTreeItems "infobase"]
}
proc Del::connections {tree host values} {
global active_cluster agent_user agent_pwd cluster_user cluster_pwd auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set connection_id [GetWorkTreeItems "connection"]
set process_id [GetWorkTreeItems "process"]
set answer [tk_messageBox -message "[::msgcat::mc "Drop down the connection"] $connection_id?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand "connection disconnect --process=$process_id --connection=$connection_id --cluster=$active_cluster $auth $host"]
#$tree delete "infobase::$values"
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
}
no {return}
}
}
proc Del::sessions {tree host values} {
global active_cluster agent_user agent_pwd cluster_user cluster_pwd auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set session_id [GetWorkTreeItems "session"]
set answer [tk_messageBox -message "[::msgcat::mc "Terminate session"] $session_id?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand "session terminate --session=$session_id --cluster=$active_cluster $auth $host"]
#$tree delete "infobase::$values"
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
}
no {return}
}
}
proc Del::rule {tree host values} {
global active_cluster server agent_user agent_pwd cluster_user cluster_pwd auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set rule_id [GetWorkTreeItems "rule"]
if {[info exists rule_id] == 0 || $rule_id eq ""} {
return
}
set answer [tk_messageBox -message "[::msgcat::mc "Remove the rule"] $rule_id?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand "rule remove --server=$server --rule=$rule_id --cluster=$active_cluster $auth $host"]
#$tree delete "infobase::$values"
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
}
no {return}
}
}
proc Del::server {tree host values} {
global dir
set answer [tk_messageBox -message "[::msgcat::mc "Delete server"] $values?" \
-icon question -type yesno ]
switch -- $answer {
yes {
file copy [file join $dir(work) 1c_srv.cfg] [file join $dir(work) 1c_srv.cfg.bak]
set orig_file [open [file join $dir(work) 1c_srv.cfg.bak] "r"]
set file [open [file join $dir(work) 1c_srv.cfg] "w"]
while {[gets $orig_file line] >=0 } {
if { $line ne "" && [string match "$values*" $line] == 0} {
puts $file $line
}
}
close $file
close $orig_file
#return "$host:$port"
$tree delete "server::$values"
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
file delete [file join $dir(work) 1c_srv.cfg.bak]
}
no {return}
}
}
proc Del::profile {tree host values} {
global active_cluster agent_user agent_pwd cluster_user cluster_pwd auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
if {$agent_user ne "" && $agent_pwd ne ""} {
set agent_auth "--agent-user=$agent_user --agent-pwd=$agent_pwd"
} else {
set agent_auth ""
}
set answer [tk_messageBox -message "[::msgcat::mc "Delete security profile"] $values?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand "profile remove --name=$values --cluster=$active_cluster $auth $host"]
.frm_tree.tree delete "profile::$values"
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
Run::profiles $tree $host $active_cluster
}
no {return}
}
}
proc Del::profiles {tree host values} {
Del::profile $tree $host [GetWorkTreeItems "name"]
}
proc Del::acl {host type name profile_name} {
global active_cluster agent_user agent_pwd cluster_user cluster_pwd auth
if {$name eq ""} {
return
}
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
if {$agent_user ne "" && $agent_pwd ne ""} {
set agent_auth "--agent-user=$agent_user --agent-pwd=$agent_pwd"
} else {
set agent_auth ""
}
if {$type eq "directory"} {
set item "\"--alias=$name\""
} else {
set item "\"--name=$name\""
}
set item [regsub -all -- " " $item "\\ "]
set answer [tk_messageBox -message "[::msgcat::mc "Delete"] $type - $name?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand "profile --cluster=$active_cluster acl --name=$profile_name $type remove $item $auth $host"]
#.frm_tree.tree delete "profile::$values"
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
Run::$type .frm_tree.tree $host $active_cluster
}
no {return}
}
}
proc Del::directory {tree host profile_name} {
Del::acl $host directory [GetWorkTreeItems "alias"] $profile_name
}
proc Del::com {tree host profile_name} {
Del::acl $host com [GetWorkTreeItems "name"] $profile_name
}
proc Del::addin {tree host profile_name} {
Del::acl $host addin [GetWorkTreeItems "name"] $profile_name
}
proc Del::module {tree host profile_name} {
Del::acl $host module [GetWorkTreeItems "name"] $profile_name
}
proc Del::app {tree host profile_name} {
Del::acl $host app [GetWorkTreeItems "name"] $profile_name
}
proc Del::inet {tree host profile_name} {
Del::acl $host inet [GetWorkTreeItems "name"] $profile_name
}