########################################## # 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 {} { # Сохраняем конфиг SaveConfig 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 servers_list \ cluster_user cluster_pwd agent_user agent_pwd set parent [$tree parent $id] set values [$tree item $id -values] set key [lindex [split $id "::"] 0] puts "$parent $values $key" switch -- $key { server { set host $values set rac_cmd_for_host($host) [dict get $servers_list servers $host rac_cmd] } work_server { set server $values } cluster { set active_cluster $values #puts $values #dict set servers_list servers $host clusters "$values {}" set cluster_user [GetClusterAdmin $host $active_cluster] set cluster_pwd [GetClusterPassword $host $active_cluster] } infobase { set infobase $values #puts [dict set servers_list servers $host clusters $active_cluster infobases $values] } profile { set profile_name $values } agent_admins { set agent_user [GetAgentAdmin $host] set agent_pwd [GetAgentPassword $host] } } 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 [::msgcat::mc [HumanReadableTextConvert $j]] } incr work_list_row_count } # Преобразование выражений (названий параметров) полученных из консоли # для отображания в графических элементах. # Т.е. выражение "session-fault-tolerance-level" # будет преобразовано в "Session fault tolerance level" proc HumanReadableTextConvert {txt} { set lst [split $txt "-"] if {[llength $lst] >0} { foreach item $lst { append str " " $item } } set str [string trim $str] set first_letter [string range $str 0 0] set str "[string toupper $first_letter][string range $str 1 end]" return $str } 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 servers_list 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 servers_list .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 } # Диалог указания пути до RAC proc SetRacCommand {} { global env tcl_platform default if {$tcl_platform(os) eq "Windows NT"} { set init_dir $env(COMMONPROGRAMFILES) } elseif {$tcl_platform(os) eq "Linux"} { set init_dir $default(rac_dir) } else { set init_dir $env(HOME) } set rac_cmd "[tk_getOpenFile -initialdir $init_dir -parent .add \ -title [::msgcat::mc "Show where is a RAC command"] -initialfile rac]" if {$rac_cmd eq ""} { return } else { #puts $rac_cmd if {[file tail $rac_cmd] ne "rac" && [file tail $rac_cmd] ne "rac.exe"} { set rac [file tail $rac_cmd] set path_to_rac [file rootname $rac_cmd] append msg [::msgcat::mc "Command must be"] " 'rac' " \ [::msgcat::mc "or"] " 'rac.exe'\n" \ [::msgcat::mc "You entered"] " '$rac' - " \ [::msgcat::mc "it's correct?"] set answer [tk_messageBox -message [::msgcat::mc $msg] -icon question -type yesno] switch -- $answer { yes { return $rac_cmd } no SetRacCommand } } else { return $rac_cmd } } } namespace eval Run {} {} # Получение данных по кластерам proc Run::server {tree host values} { global rac_cmd_for_host rac_cmd servers_list 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] set cluster_name [lindex $cluster($x) 1] if { [$tree exists "cluster::$id"] == 0 } { $tree insert "server::$host" end -id "cluster::$id" -text "$cluster_name" -values "$id" InsertClusterItems $tree $id } #dict replace servers_list [dict get servers_list servers $host clusters] dict set servers_list servers $host clusters $id cluster_name $cluster_name #puts $cluster_name #puts $servers_list } 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 servers_list .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" if {![dict exists $servers_list servers $host clusters $active_cluster infobases $id]} { dict set servers_list servers $host clusters $active_cluster \ infobases $id "name \"[lindex $base($x) 1]\"" } } InsertBaseItems $tree $id } #dict update dictionaryVariable key varName ?key varName ...? body } proc Run::infobase {tree host values} { global active_cluster cluster_user cluster_pwd default servers_list if {$cluster_user ne "" && $cluster_pwd ne ""} { set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd" } else { set auth "" } #### Проверяем наличие юзера и пароля в конфиге и если есть то используем #### set infobase_user [GetInfobaseUser $host $active_cluster $values] set infobase_pwd [GetInfobasePassword $host $active_cluster $values] if {$infobase_user ne "" && $infobase_pwd ne ""} { set ib_auth "--infobase-user=$infobase_user --infobase-pwd=$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 bind $win_name $cmd 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 servers_list set frm [AddToplevel [::msgcat::mc "Main server"] server_grey_64] ttk::label $frm.lbl_server_name -text [::msgcat::mc "Name"] ttk::entry $frm.ent_server_name 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 ttk::button $frm.btn_path_to_rac -text "..." -width 3 $frm.ent_port insert end $default(port) grid $frm.lbl_server_name -row 0 -column 0 -sticky nsw -padx 5 -pady 5 grid $frm.ent_server_name -row 0 -column 1 -columnspan 2 -sticky nsew -padx 5 -pady 5 grid $frm.lbl_host -row 1 -column 0 -sticky nsw -padx 5 -pady 5 grid $frm.ent_host -row 1 -column 1 -columnspan 2 -sticky nsew -padx 5 -pady 5 grid $frm.lbl_port -row 2 -column 0 -sticky nsw -padx 5 -pady 5 grid $frm.ent_port -row 2 -column 1 -columnspan 2 -sticky nesw -padx 5 -pady 5 grid $frm.lbl_path_to_rac -row 3 -column 0 -sticky nsw -padx 5 -pady 5 grid $frm.ent_path_to_rac -row 3 -column 1 -sticky nsew -padx 5 -pady 5 grid $frm.btn_path_to_rac -row 3 -column 2 -sticky new -padx 5 -pady 5 grid columnconfigure $frm 0 -weight 1 grid rowconfigure $frm 0 -weight 1 $frm.btn_path_to_rac configure -command { .add.frm.ent_path_to_rac delete 0 end .add.frm.ent_path_to_rac insert end [SetRacCommand] } .add.frm_btn.btn_ok configure -command { set msg "" set server_name "[.add.frm.ent_server_name get]" set host "[.add.frm.ent_host get]:[.add.frm.ent_port get]" set rac_cmd_for_host($host) "[.add.frm.ent_path_to_rac get]" if {$rac_cmd_for_host($host) eq ""} { append msg [::msgcat::mc "Command must be"] " 'rac' " \ [::msgcat::mc "or"] " 'rac.exe'\n" tk_messageBox -message [::msgcat::mc $msg] -icon question -type ok return } dict set servers_list servers $host "name \"$server_name\" rac_cmd \"$rac_cmd_for_host($host)\" clusters {}" #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] #puts $servers_list .frm_tree.tree insert {} end -id "server::$host" -text "$server_name" -values "$host" destroy .add unset msg #SaveConfig return $host } return $frm } proc Add::servers {tree host values} { global default dedicate_managers using active_cluster cluster_user cluster_pwd auth \ servers_list 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 "Port 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 "Safe working processes memory limit"] 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 call memory limit"] 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 limit"] ttk::entry $frm.ent_memory_limit $frm.ent_memory_limit insert end $default(ram_work) ttk::label $frm.lbl_infobases_limit -text [::msgcat::mc "Infobases limit"] ttk::entry $frm.ent_infobases_limit $frm.ent_infobases_limit insert end $default(infobases_limit) ttk::label $frm.lbl_connections_limit -text [::msgcat::mc "Connections limit"] ttk::entry $frm.ent_connections_limit $frm.ent_connections_limit insert end $default(connections_limit) ttk::label $frm.lbl_cluster_port -text [::msgcat::mc "Сluster port"] ttk::entry $frm.ent_cluster_port $frm.ent_cluster_port insert end $default(port) ttk::label $frm.lbl_dedicate_managers -text [::msgcat::mc "Dedicate managers"] 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 ttk::label $frm.lbl_critical_total_memory -text [::msgcat::mc "Critical total memory"] ttk::entry $frm.ent_critical_total_memory $frm.ent_critical_total_memory insert end $default(critical_total_memory) ttk::label $frm.lbl_temporary_allowed_total_memory \ -text [::msgcat::mc "Temporary allowed total memory"] ttk::entry $frm.ent_temporary_allowed_total_memory $frm.ent_temporary_allowed_total_memory insert end $default(temporary_allowed_total_memory) ttk::label $frm.lbl_temporary_allowed_total_memory_time_limit \ -text [::msgcat::mc "Temporary allowed total memory time limit"] ttk::entry $frm.ent_temporary_allowed_total_memory_time_limit $frm.ent_temporary_allowed_total_memory_time_limit insert end $default(temporary_allowed_total_memory_time_limit) 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_cluster_port -row 12 -column 0 -sticky nw -padx 5 -pady 5 grid $frm.ent_cluster_port -row 12 -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_critical_total_memory -row 9 -column 0 -sticky nw -padx 5 -pady 5 grid $frm.ent_critical_total_memory -row 9 -column 1 -sticky nsew -padx 5 -pady 5 grid $frm.lbl_temporary_allowed_total_memory -row 10 -column 0 -sticky nw -padx 5 -pady 5 grid $frm.ent_temporary_allowed_total_memory -row 10 -column 1 -sticky nsew -padx 5 -pady 5 grid $frm.lbl_temporary_allowed_total_memory_time_limit \ -row 11 -column 0 -sticky nw -padx 5 -pady 5 grid $frm.ent_temporary_allowed_total_memory_time_limit \ -row 11 -column 1 -sticky nsew -padx 5 -pady 5 grid $frm.lbl_dedicate_managers -row 13 -column 0 -sticky nw -padx 5 -pady 5 grid $frm.check_dedicate_managers -row 13 -column 1 -sticky nw -padx 5 -pady 5 grid $frm.lbl_using -row 14 -column 0 -sticky nw -padx 5 -pady 5 grid $frm.check_using -row 14 -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] \ --critical-total-memory=[.add.frm.ent_critical_total_memory get] \ --temporary-allowed-total-memory=[.add.frm.ent_temporary_allowed_total_memory get] \ --temporary-allowed-total-memory-time-limit=[.add.frm.ent_temporary_allowed_total_memory_time_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=[regsub -all -- " " [.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 kill_by_memory_with_dump \ 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 kill_problem_processes no set kill_by_memory_with_dump no set frm [AddToplevel [::msgcat::mc "Cluster"] cluster_grey_64] ttk::label $frm.lbl_host -text [::msgcat::mc "Host"] 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_security_level -text [::msgcat::mc "Security level"] ttk::combobox $frm.cb_security_level -textvariable security_level -values $default(security_level) ttk::label $frm.lbl_expiration_timeout -text [::msgcat::mc "Expiration timeout"] ttk::entry $frm.ent_expiration_timeout -textvariable expiration_timeout ttk::label $frm.lbl_session_fault_tolerance_level \ -text [::msgcat::mc "Session 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 "Errors count threshold"] ttk::entry $frm.ent_errors_count_threshold -textvariable errors_count_threshold ttk::label $frm.lbl_processes -text [::msgcat::mc "Processes"] ttk::label $frm.lbl_lifetime_limit -text [::msgcat::mc "Lifetime limit"] ttk::entry $frm.ent_lifetime_limit -textvariable lifetime_limit ttk::label $frm.lbl_max_memory_size -text [::msgcat::mc "Max memory size"] ttk::entry $frm.ent_max_memory_size -textvariable max_memory_size ttk::label $frm.lbl_max_memory_time_limit -text [::msgcat::mc "Max memory time limit"] 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 "Kill problem processes"] ttk::checkbutton $frm.check_kill_problem_processes \ -variable kill_problem_processes -onvalue yes -offvalue no ttk::checkbutton $frm.check_kill_by_memory_with_dump \ -variable kill_by_memory_with_dump -onvalue yes -offvalue no ttk::label $frm.lbl_kill_by_memory_with_dump -justify left -anchor nw \ -text [::msgcat::mc "Kill by memory with dump"] 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_security_level -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 grid $frm.lbl_kill_by_memory_with_dump -row 13 -column 0 -sticky nw -padx 5 -pady 5 grid $frm.check_kill_by_memory_with_dump -row 13 -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=[regsub -all -- " " [.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 \ --kill-by-memory-with-dump=$kill_by_memory_with_dump \ $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 servers_list set frm [Add::server] wm title .add [::msgcat::mc "Edit record"] set lst [split $value ":"] set prev_address $value .add.frm.ent_server_name delete 0 end .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_server_name insert end [dict get $servers_list servers $prev_address name] .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 [dict get $servers_list servers $prev_address rac_cmd] .add.frm_btn.btn_ok configure -command { set host "[.add.frm.ent_host get]:[.add.frm.ent_port get]" set server_name [.add.frm.ent_server_name 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 "$server_name" -values "$host" set clusters [dict get $servers_list servers $prev_address clusters] dict unset servers_list servers $prev_address dict set servers_list servers $host "name \"$server_name\" rac_cmd $rac_cmd_for_host($host) clusters \{$clusters\}" unset clusters server_name #puts $servers_list destroy .add SaveConfig 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 \ kill_by_memmory_with_dump 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=[regsub -all -- " " [.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 \ --kill-by-memory-with-dump=$kill_by_memory_with_dump \ $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 infobase_user infobase_pwd ib_auth if {$cluster_user ne "" && $cluster_pwd ne ""} { set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd" } else { set auth "" } #### Проверяем наличие юзера и пароля в конфиге и если есть то используем #### set infobase_user [GetInfobaseUser $host $active_cluster $values] set infobase_pwd [GetInfobasePassword $host $active_cluster $values] if {$infobase_user ne "" && $infobase_pwd ne ""} { set ib_auth "--infobase-user=$infobase_user --infobase-pwd=$infobase_pwd" } else { set ib_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 $auth --infobase=$values $ib_auth $host"] FormFieldsDataInsert $frm $lst .add.frm_btn.btn_ok configure -command { RunCommand "infobase update \ --infobase=$infobase \ --infobase-user=$infobase_user \ --infobase-pwd=$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] \ --critical-total-memory=[.add.frm.ent_critical_total_memory get] \ --temporary-allowed-total-memory=[.add.frm.ent_temporary_allowed_total_memory get] \ --temporary-allowed-total-memory-time-limit=[.add.frm.ent_temporary_allowed_total_memory_time_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 servers_list set answer [tk_messageBox -message "[::msgcat::mc "Delete server"] $values?" \ -icon question -type yesno ] switch -- $answer { yes { dict unset servers_list servers $values SaveConfig $tree delete "server::$values" .frm_work.tree_work delete [ .frm_work.tree_work children {}] return # данный код не используется. УДАЛИТЬ! file copy [file join $dir(work) 1c_srv_new.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 file delete [file join $dir(work) 1c_srv.cfg.bak] #return "$host:$port" ########## Конец Удаления ############# } 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 }