mirrors/1c_rac-gui
1
0
Fork 0
mirror of https://bitbucket.org/svk28/rac-gui synced 2024-11-13 09:06:53 +00:00
Code Releases Activity
ad8ed8617b
1c_rac-gui/lib/function.tcl

1740 lines
72 KiB
Tcl
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

###########################################
# Rac GUI
# Distributed under GNU Public License
# Author: Sergey Kalinin svk@nuk-svk.ru
# Copyright (c) "http://nuk-svk.ru", 2018
# https://bitbucket.org/svk28/rac-gui
###########################################
proc Quit {} {
exit
}
set active_cluster ""
set host ""
set infobase ""
set server ""
proc TreePress {tree} {
global host server active_cluster infobase
set id [$tree selection]
SetGlobalVarFromTreeItems $tree $id
set values [$tree item $id -values]
set key [lindex [split $id "::"] 0]
puts $key
Run::$key $tree $host $values
}
proc SetGlobalVarFromTreeItems {tree id} {
global host server active_cluster infobase
set parent [$tree parent $id]
set values [$tree item $id -values]
set key [lindex [split $id "::"] 0]
switch -- $key {
server {set host $values}
work_server {set server $values}
cluster {set active_cluster $values}
infobase {set infobase $values}
}
if {$parent eq ""} {
return
} else {
SetGlobalVarFromTreeItems $tree $parent
}
}
proc InsertItemsWorkList {lst} {
global work_list_row_count
if [expr $work_list_row_count % 2] {
set tag dark
} else {
set tag light
}
foreach i $lst {
if [regexp -nocase -all -- {(\D+)(\s*?|)(:)(\s*?|)(.*)} $i match param v2 v3 v4 value] {
lappend column_list [string trim $param]
lappend value_list [string trim $value]
}
}
.frm_work.tree_work configure -columns $column_list -displaycolumns $column_list
.frm_work.tree_work insert {} end -values $value_list -tags $tag
.frm_work.tree_work column #0 -stretch
foreach j $column_list {
.frm_work.tree_work heading $j -text $j
}
incr work_list_row_count
}
proc RunCommand {root par} {
global dir rac_cmd cluster work_list_row_count \
agent_user agent_pwd cluster_user cluster_pwd
puts "$rac_cmd $par"
set work_list_row_count 0
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
#RunCommand $root $par
}
# fileevent $pipe readable [list DebugInfo .frm_work.tree_work $pipe]
# fconfigure $pipe -buffering none -blocking no
}
proc ErrorParcing {err opt} {
global cluster_user cluster_pwd agent_user agent_pwd
switch -regexp -- $err {
"Cluster administrator is not authenticated" {
AuthorisationDialog "Администратор кластера"
.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" {
#tk_messageBox -type ok -message "Логиницоооооооооооооо!"
AuthorisationDialog "Администратор агента кластера"
.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
}
}
}
}
proc AuthorisationDialog {txt} {
global active_cluster agent_user agent_pwd cluster_user cluster_pwd
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set frm [AddToplevel "$txt" administrator_grey_64 .auth_win]
wm title .auth_win "Авторизация"
label $frm.lbl_name -text "Имя пользователя"
entry $frm.ent_name
label $frm.lbl_pwd -text "Пароль"
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 "Информационные базы" -values "$id"
$tree insert $parent end -id "servers::$id" -text "Рабочие серверы" -values "$id"
$tree insert $parent end -id "admins::$id" -text "Администраторы" -values "$id"
$tree insert $parent end -id "managers::$id" -text "Менеджеры кластера" -values $id
$tree insert $parent end -id "processes::$id" -text "Рабочие процессы" -values "workprocess-all"
$tree insert $parent end -id "sessions::$id" -text "Сеансы" -values "sessions-all"
$tree insert $parent end -id "locks::$id" -text "Блокировки" -values "blocks-all"
$tree insert $parent end -id "connections::$id" -text "Соединения" -values "connections-all"
$tree insert $parent end -id "profiles::$id" -text "Профили безопасности" -values "secureprofiles-all"
}
proc InsertBaseItems {tree id} {
set parent "infobase::$id"
if { [$tree exists "sessions::$id"] == 0 } {
$tree insert $parent end -id "sessions::$id" -text "Сеансы" -values "$id"
}
if { [$tree exists "locks::$id"] == 0 } {
$tree insert $parent end -id "locks::$id" -text "Блокировки" -values "$id"
}
if { [$tree exists "connections::$id"] == 0 } {
$tree insert $parent end -id "connections::$id" -text "Соединения" -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 "Процессы" -values "$id"
}
if { [$tree exists "work_server_licenses::$id"] == 0 } {
$tree insert $parent end -id "work_server_licenses::$id" -text "Лицензии" -values "$id"
}
if { [$tree exists "rule::$id"] == 0 } {
$tree insert $parent end -id "rule::$id" -text "Требования назначения функциональности" -values "$id"
}
if { [$tree exists "services::$id"] == 0 } {
# $tree insert $parent end -id "services::$id" -text "Сервисы" -values "$id"
}
}
proc GetInfobases {cluster host} {
set lst [RunCommand "" "infobase summary --cluster=$cluster 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] {
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} {
global dir
set file [open [file join $dir(work) 1c_srv.cfg] "a+"]
puts $file "$host:$port"
close $file
return "$host:$port"
}
namespace eval Run {} {}
# Получение данных по кластерам
proc Run::server {tree host values} {
set lst [RunCommand server::$host "cluster list $host"]
set l [lindex $lst 0]
#puts $lst
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
foreach cluster_list $lst {
InsertItemsWorkList $cluster_list
foreach i $cluster_list {
#puts $i
set cluster_list [split $i ":"]
if {[string trim [lindex $cluster_list 0]] eq "cluster"} {
set cluster_id [string trim [lindex $cluster_list 1]]
lappend cluster($cluster_id) $cluster_id
}
if {[string trim [lindex $cluster_list 0]] eq "name"} {
lappend cluster($cluster_id) [string trim [lindex $cluster_list 1]]
}
}
}
foreach x [array names cluster] {
set id [lindex $cluster($x) 0]
if { [$tree exists "cluster::$id"] == 0 } {
$tree insert "server::$host" end -id "cluster::$id" -text "[lindex $cluster($x) 1]" -values "$id"
InsertClusterItems $tree $id
}
}
if { [$tree exists "agent_admins::$id"] == 0 } {
$tree insert "server::$host" end -id "agent_admins::$id" -text "Администраторы" -values "$id"
#InsertClusterItems $tree $id
}
}
proc Run::cluster {tree host values} {
global active_cluster
set active_cluster $values
RunCommand cluster::$values "cluster info --cluster=$values $host"
}
proc Run::cluster_managers {tree host values} {
}
proc Run::services {tree host values} {
global active_cluster
Run::List $tree $host $active_cluster service
}
proc Run::infobases {tree host values} {
global active_cluster cluster_user cluster_pwd
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set lst [RunCommand infobase::$values "infobase summary --cluster=$active_cluster $auth list $host"]
puts $lst
foreach info_bases_list $lst {
foreach i $info_bases_list {
set base_list [split $i ":"]
if {[string trim [lindex $base_list 0]] eq "infobase"} {
set base_id [string trim [lindex $base_list 1]]
lappend base($base_id) $base_id
}
if {[string trim [lindex $base_list 0]] eq "name"} {
lappend base($base_id) [string trim [lindex $base_list 1]]
}
#InsertItemsWorkList $base_list
}
InsertItemsWorkList $info_bases_list
}
foreach x [array names base] {
set id [lindex $base($x) 0]
if { [$tree exists "infobase::$id"] == 0 } {
$tree insert "infobases::$values" end -id "infobase::$id" -text "[lindex $base($x) 1]" -values "$id"
}
InsertBaseItems $tree $id
}
}
proc Run::infobase {tree host values} {
global active_cluster cluster_user cluster_pwd
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 infobase::$values "infobase info --cluster=$active_cluster $auth --infobase=$values $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 infobase::$values "$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 infobase::$values "$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 infobase::$values "server 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 "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 infobase::$values "server info --cluster=$active_cluster --server=$values $auth $host"]
foreach l $lst {
InsertItemsWorkList $l
}
}
proc Run::profiles {tree host values} {
Run::List $tree $host $values profile
}
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 work_server_processes::$values "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 work_server_processes::$values "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 cluster::$values "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
}
return
}
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
}
return
}
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 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} {
if [winfo exists .add] {destroy .add}
toplevel .add
wm title .add $lbl
#wm iconphoto .add server_grey_64
ttk::label .add.lbl -image $img
set frm [ttk::labelframe .add.frm -text $lbl -labelanchor nw]
grid columnconfigure $frm 0 -weight 1
grid rowconfigure $frm 0 -weight 1
set frm_btn [frame .add.frm_btn -border 0]
ttk::button $frm_btn.btn_ok -image ok_grey_24 -command { }
ttk::button $frm_btn.btn_cancel -command {destroy .add} -image quit_grey_24
grid .add.lbl -row 0 -column 0 -sticky nw -padx 5 -pady 10
grid $frm -row 0 -column 1 -sticky nw -padx 5 -pady 5
grid $frm_btn -row 1 -column 1 -sticky se -padx 5 -pady 5
pack $frm_btn.btn_cancel -side right
pack $frm_btn.btn_ok -side right -padx 10
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 $lbl
#wm iconphoto $win_name server_grey_64
ttk::label $win_name.lbl -image $img
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 [frame $win_name.frm_btn -border 0]
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 nw -padx 5 -pady 10
grid $frm -row 0 -column 1 -sticky nw -padx 5 -pady 5
grid $frm_btn -row 1 -column 1 -sticky se -padx 5 -pady 5
pack $frm_btn.btn_cancel -side right
pack $frm_btn.btn_ok -side right -padx 10
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 "Добавление администратора агента кластера" administrator_grey_64]
set auth [lindex $default(auth) 0]
label $frm.lbl_name -text "Имя пользователя"
entry $frm.ent_name
label $frm.lbl_pwd -text "Пароль"
entry $frm.ent_pwd
label $frm.lbl_descr -text "Примечание"
entry $frm.ent_descr
label $frm.lbl_auth -text "Способ аутентификации"
ttk::combobox $frm.cb_auth -textvariable auth -values $default(auth)
label $frm.lbl_os_user -text "Пользователь ОС"
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]
wm title .add "Добавление администратора кластера"
.add.frm configure -text "Добавление администратора кластера"
.add.frm_btn.btn_ok configure -command {
RunCommand "" "cluster 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] \
--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
set frm [AddToplevel "Добавление основного сервера" server_grey_64]
label $frm.lbl_host -text "Адрес сервера"
entry $frm.ent_host
label $frm.lbl_port -text "Порт"
entry $frm.ent_port
$frm.ent_port insert end $default(port)
grid $frm.lbl_host -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_host -row 0 -column 1 -sticky 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 columnconfigure $frm 0 -weight 1
grid rowconfigure $frm 0 -weight 1
#set frm_btn [frame .add.frm_btn -border 0]
.add.frm_btn.btn_ok configure -command {
set host [SaveMainServer [.add.frm.ent_host get] [.add.frm.ent_port get]]
.frm_tree.tree insert {} end -id "server::$host" -text "$host" -values "$host"
destroy .add
return $host
}
return $frm
}
proc Add::servers {tree host values} {
global default dedicate_managers using active_cluster cluster_user cluster_pwd
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set dedicate_manager "none"
set using_central_server "normal"
#set active_cluster $values
set frm [AddToplevel "Добавление рабочего сервера" server_grey_64]
label $frm.lbl_name -text "Описание сервера"
entry $frm.ent_name
label $frm.lbl_agent_host -text "Адрес сервера"
entry $frm.ent_agent_host
label $frm.lbl_agent_port -text "Порт"
entry $frm.ent_agent_port
$frm.ent_agent_port insert end $default(port)
label $frm.lbl_port_range -text "Диапазон портов"
entry $frm.ent_port_range
$frm.ent_port_range insert end $default(port_range)
label $frm.lbl_safe_working_processes_memory_limit -text "Максимальный объём памяти раб. процессов"
entry $frm.ent_safe_working_processes_memory_limit
$frm.ent_safe_working_processes_memory_limit insert end $default(safe_working_processes_memory_limit)
label $frm.lbl_safe_call_memory_limit -text "Безопасный расход памяти за вызов"
entry $frm.ent_safe_call_memory_limit
$frm.ent_safe_call_memory_limit insert end $default(safe_call_memory_limit)
label $frm.lbl_memory_limit -text "Объём памяти рабочих процессов"
entry $frm.ent_memory_limit
$frm.ent_memory_limit insert end $default(ram_work)
label $frm.lbl_infobases_limit -text "Количество ИБ на процесс"
entry $frm.ent_infobases_limit
$frm.ent_infobases_limit insert end $default(infobases_limit)
label $frm.lbl_connections_limit -text "Количество соединений на процесс"
entry $frm.ent_connections_limit
$frm.ent_connections_limit insert end $default(connections_limit)
label $frm.lbl_cluster_port -text "Порт главного менеджера кластера"
entry $frm.ent_cluster_port
$frm.ent_cluster_port insert end $default(port)
label $frm.lbl_dedicate_managers -text "Менеджер под каждый сервис"
checkbutton $frm.check_dedicate_managers -variable dedicate_managers -onvalue all -offvalue none
label $frm.lbl_using -text "Центральный сервер"
checkbutton $frm.check_using -variable using -onvalue main -offvalue normal
grid $frm.lbl_name -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_agent_host -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_agent_host -row 1 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_agent_port -row 2 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_agent_port -row 2 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_port_range -row 3 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_port_range -row 3 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_safe_working_processes_memory_limit -row 4 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_safe_working_processes_memory_limit -row 4 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_safe_call_memory_limit -row 5 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_safe_call_memory_limit -row 5 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_memory_limit -row 6 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_memory_limit -row 6 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_infobases_limit -row 7 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_infobases_limit -row 7 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_connections_limit -row 8 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_connections_limit -row 8 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_cluster_port -row 9 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_cluster_port -row 9 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_dedicate_managers -row 10 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.check_dedicate_managers -row 10 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_using -row 11 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.check_using -row 11 -column 1 -sticky nw -padx 5 -pady 5
.add.frm_btn.btn_ok configure -command {
RunCommand "" "server insert \
--agent-host=[.add.frm.ent_agent_host get] \
--agent-port=[.add.frm.ent_agent_port get] \
--port-range=[.add.frm.ent_port_range get] \
--name=[.add.frm.ent_name get] \
--using=$using \
--infobases-limit=[.add.frm.ent_infobases_limit get] \
--memory-limit=[.add.frm.ent_memory_limit get] \
--connections-limit=[.add.frm.ent_connections_limit get] \
--cluster-port=[.add.frm.ent_cluster_port get] \
--dedicate-managers=$dedicate_managers \
--safe-working-processes-memory-limit=[.add.frm.ent_safe_working_processes_memory_limit get] \
--safe-call-memory-limit=[.add.frm.ent_safe_call_memory_limit get] \
--cluster=$active_cluster $auth $host"
Run::servers $tree $host $active_cluster
destroy .add
}
return $frm
}
proc Add::work_server {tree host values} {
return [Add::servers $tree $host $values]
}
proc Add::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
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 secure_level [lindex $default(secure_level) 0]
set date_offset [lindex $default(date_offset) 0]
set dbms [lindex $default(dbms) 0]
set block_shedule on
set frm [AddToplevel "Добавление информационной базы" database_grey_64]
label $frm.lbl_name -text "Имя информационной базы"
entry $frm.ent_name
label $frm.lbl_descr -text "Описание"
entry $frm.ent_descr
label $frm.lbl_security_level -text "Защищённое соединение"
ttk::combobox $frm.cb_security_level -textvariable security_level -values $default(secure_level)
label $frm.lbl_db_server -text "Адрес сервера баз данных"
entry $frm.ent_db_server
label $frm.lbl_dbms -text "Тип СУБД"
ttk::combobox $frm.cb_dbms -textvariable dbms -values $default(dbms)
label $frm.lbl_db_name -text "База данных"
entry $frm.ent_db_name
label $frm.lbl_db_user -text "Имя пользователя базы данных"
entry $frm.ent_db_user
label $frm.lbl_db_pwd -text "Пароль"
entry $frm.ent_db_pwd
#$frm.ent_host insert end $host
label $frm.lbl_locale -text "Язык базы данных"
entry $frm.ent_locale
$frm.ent_locale insert end $default(locale)
label $frm.lbl_date_offset -text "Смещение дат"
ttk::combobox $frm.cb_date_offset -textvariable date_offset -values $default(date_offset)
label $frm.lbl_license_distribution -justify left -anchor nw -text "Разрешить выдачу лицензий\nсервером 1С"
checkbutton $frm.cb_license_distribution -variable license_distribution -onvalue allow -offvalue deny
label $frm.lbl_create_db -text "Создать БД в случае её отсутствия"
checkbutton $frm.cb_create_db -variable create_db -onvalue true -offvalue false
label $frm.lbl_scheduled_jobs_deny -text "Блокировка регламентных заданий"
checkbutton $frm.cb_scheduled_jobs_deny -variable scheduled_jobs_deny -onvalue on -offvalue off
grid $frm.lbl_name -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 0 -column 1 -sticky new -padx 5 -pady 5
grid $frm.lbl_descr -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_descr -row 1 -column 1 -sticky new -padx 5 -pady 5
grid $frm.lbl_security_level -row 2 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_security_level -row 2 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_db_server -row 3 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_db_server -row 3 -column 1 -sticky new -padx 5 -pady 5
grid $frm.lbl_dbms -row 4 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_dbms -row 4 -column 1 -sticky new -padx 5 -pady 5
grid $frm.lbl_db_name -row 5 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_db_name -row 5 -column 1 -sticky new -padx 5 -pady 5
grid $frm.lbl_db_user -row 6 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_db_user -row 6 -column 1 -sticky new -padx 5 -pady 5
grid $frm.lbl_db_pwd -row 7 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_db_pwd -row 7 -column 1 -sticky new -padx 5 -pady 5
grid $frm.lbl_locale -row 8 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_locale -row 8 -column 1 -sticky new -padx 5 -pady 5
grid $frm.lbl_date_offset -row 9 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_date_offset -row 9 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_license_distribution -row 10 -column 0 -sticky nsew -padx 5 -pady 5
grid $frm.cb_license_distribution -row 10 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_create_db -row 11 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_create_db -row 11 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_scheduled_jobs_deny -row 12 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_scheduled_jobs_deny -row 12 -column 1 -sticky nw -padx 5 -pady 5
#set active_cluster $values
# Проверяем значение чекбокса и выставляем соответсвющую опцию
.add.frm_btn.btn_ok configure -command {
if {$create_db eq "true"} {
set db_create "--create-database"
} else {
set db_create ""
}
RunCommand "" "infobase create $db_create \
--name=[.add.frm.ent_name get] \
--dbms=$dbms \
--db-server=[.add.frm.ent_db_server get] \
--db-name=[.add.frm.ent_db_name get] \
--locale=[.add.frm.ent_locale get] \
--db-user=[.add.frm.ent_db_user get] \
--db-pwd=[.add.frm.ent_db_pwd get] \
--descr=\"[.add.frm.ent_descr get]\" \
--date-offset=$date_offset \
--security-level=$security_level \
--scheduled-jobs-deny=$scheduled_jobs_deny \
--license-distribution=$license_distribution \
--cluster=$active_cluster $auth $host"
Run::infobases $tree $host $active_cluster
destroy .add
}
return $frm
}
proc Add::cluster {tree host values} {
global default lifetime_limit expiration_timeout session_fault_tolerance_level
global max_memory_size max_memory_time_limit errors_count_threshold security_level
global load_balancing_mode kill_problem_processes \
agent_user agent_pwd cluster_user cluster_pwd auth_agent
if {$agent_user ne "" && $agent_pwd ne ""} {
set auth_agent "--agent-user=$agent_user --agent-pwd=$agent_pwd"
} else {
set auth_agent ""
}
set lifetime_limit $default(lifetime_limit)
set expiration_timeout $default(expiration_timeout)
set session_fault_tolerance_level $default(session_fault_tolerance_level)
set max_memory_size $default(max_memory_size)
set max_memory_time_limit $default(max_memory_time_limit)
set errors_count_threshold $default(errors_count_threshold)
set secure_level [lindex $default(secure_level) 0]
set load_balancing_mode [lindex $default(load_balancing_mode) 0]
set frm [AddToplevel "Добавление кластера" cluster_grey_64]
label $frm.lbl_host -text "Адрес основного сервера"
entry $frm.ent_host
label $frm.lbl_port -text "Порт"
entry $frm.ent_port
$frm.ent_port insert end $default(port)
label $frm.lbl_name -text "Название кластера"
entry $frm.ent_name
label $frm.lbl_secure_connect -text "Защищённое соединение"
ttk::combobox $frm.cb_security_level -textvariable security_level -values $default(secure_level)
label $frm.lbl_expiration_timeout -text "Останавливать выключенные процессы через:"
entry $frm.ent_expiration_timeout -textvariable expiration_timeout
label $frm.lbl_session_fault_tolerance_level -text "Уровень отказоустойчивости"
entry $frm.ent_session_fault_tolerance_level -textvariable session_fault_tolerance_level
label $frm.lbl_load_balancing_mode -text "Режим распределения нагрузки"
ttk::combobox $frm.cb_load_balancing_mode -textvariable load_balancing_mode \
-values $default(load_balancing_mode)
label $frm.lbl_errors_count_threshold -text "Допустимое отклонение количества ошибок сервера, %"
entry $frm.ent_errors_count_threshold -textvariable errors_count_threshold
label $frm.lbl_processes -text "Рабочие процессы:"
label $frm.lbl_lifetime_limit -text "Период перезапуска, сек."
entry $frm.ent_lifetime_limit -textvariable lifetime_limit
label $frm.lbl_max_memory_size -text "Допустимый объём памяти, КБ"
entry $frm.ent_max_memory_size -textvariable max_memory_size
label $frm.lbl_max_memory_time_limit -text "Интервал превышения допустимого объёма памяти, сек."
entry $frm.ent_max_memory_time_limit -textvariable max_memory_time_limit
label $frm.lbl_kill_problem_processes -justify left -anchor nw -text "Принудительно завершать проблемные процессы"
checkbutton $frm.check_kill_problem_processes -variable kill_problem_processes -onvalue yes -offvalue no
grid $frm.lbl_host -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_host -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_port -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_port -row 1 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_name -row 2 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 2 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_secure_connect -row 3 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_security_level -row 3 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_expiration_timeout -row 4 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_expiration_timeout -row 4 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_session_fault_tolerance_level -row 5 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_session_fault_tolerance_level -row 5 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_load_balancing_mode -row 6 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_load_balancing_mode -row 6 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_errors_count_threshold -row 7 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_errors_count_threshold -row 7 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_processes -row 8 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.lbl_lifetime_limit -row 9 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_lifetime_limit -row 9 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_max_memory_size -row 10 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_max_memory_size -row 10 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_max_memory_time_limit -row 11 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_max_memory_time_limit -row 11 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_kill_problem_processes -row 12 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.check_kill_problem_processes -row 12 -column 1 -sticky nw -padx 5 -pady 5
.add.frm_btn.btn_ok configure -command {
RunCommand "" "cluster insert \
--host=[.add.frm.ent_host get] \
--port=[.add.frm.ent_port get] \
--name=[.add.frm.ent_name get] \
--expiration-timeout=$expiration_timeout \
--lifetime-limit=$lifetime_limit \
--max-memory-size=$max_memory_size \
--max-memory-time-limit=$max_memory_time_limit \
--security-level=$security_level \
--session-fault-tolerance-level=$session_fault_tolerance_level \
--load-balancing-mode=$load_balancing_mode \
--errors-count-threshold=$errors_count_threshold \
--kill-problem-processes=$kill_problem_processes \
$auth_agent $host"
Run::server $tree $host ""
destroy .add
}
return $frm
}
proc Add::rule {tree host values} {
global default active_cluster infobase object_type server infobase_name rule_type \
agent_user agent_pwd cluster_user cluster_pwd
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 "Требование назначения функциональности" functional_grey_64]
#set type [lindex $default(obtype) 0]
set infobase_name ""
label $frm.lbl_object_type -text "Объект требования"
ttk::combobox $frm.cb_object_type -textvariable object_type \
-values $default(object_type)
label $frm.lbl_rule_type -text "Тип требования"
ttk::combobox $frm.cb_rule_type -textvariable rule_type \
-values $default(rule_type)
label $frm.lbl_infobase_name -text "Имя ИБ"
ttk::combobox $frm.cb_infobase_name -textvariable infobase_name \
-values [GetInfobases $active_cluster $host]
label $frm.lbl_application_ext -text "Значение доп. параметра"
entry $frm.ent_application_ext
label $frm.lbl_priority -text "Приоритет"
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 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]
Edit::$key $tree $host $values
}
namespace eval Edit {} {}
proc Edit::admins {tree host value} {
return
}
proc Edit::server {tree host value} {
global dir prev_address
set frm [Add::server]
$frm configure -text "Редактирование основного сервера"
set lst [split $value ":"]
set prev_address $value
.add.frm.ent_host delete 0 end
.add.frm.ent_port delete 0 end
.add.frm.ent_host insert end [lindex $lst 0]
.add.frm.ent_port insert end [lindex $lst 1]
.add.frm_btn.btn_ok configure -command {
set host "[.add.frm.ent_host get]:[.add.frm.ent_port get]"
.frm_tree.tree delete "server::$prev_address"
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
.frm_tree.tree insert {} end -id "server::$host" -text "$host" -values "$host"
file copy [file join $dir(work) 1c_srv.cfg] [file join $dir(work) 1c_srv.cfg.bak]
set orig_file [open [file join $dir(work) 1c_srv.cfg.bak] "r"]
set file [open [file join $dir(work) 1c_srv.cfg] "w"]
while {[gets $orig_file line] >=0 } {
if { $line eq "$prev_address"} {
puts $file $host
} else {
puts $file $line
}
}
close $file
close $orig_file
#return "$host:$port"
file delete [file join $dir(work) rac_gui .cfg.bak]
destroy .add
return $host
}
}
proc Edit::cluster {tree host values} {
global default lifetime_limit expiration_timeout session_fault_tolerance_level
global max_memory_size max_memory_time_limit errors_count_threshold security_level
global load_balancing_mode kill_problem_processes active_cluster \
agent_user agent_pwd cluster_user cluster_pwd
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]
$frm configure -text "Редактирование кластера"
set active_cluster $values
set lst [RunCommand cluster::$values "cluster info --cluster=$active_cluster $auth $host"]
FormFieldsDataInsert $frm $lst
$frm.ent_host configure -state disable
$frm.ent_port configure -state disable
.add.frm_btn.btn_ok configure -command {
RunCommand "" "cluster update \
--cluster=$active_cluster $auth \
--name=[.add.frm.ent_name get] \
--expiration-timeout=$expiration_timeout \
--lifetime-limit=$lifetime_limit \
--max-memory-size=$max_memory_size \
--max-memory-time-limit=$max_memory_time_limit \
--security-level=$security_level \
--session-fault-tolerance-level=$session_fault_tolerance_level \
--load-balancing-mode=$load_balancing_mode \
--errors-count-threshold=$errors_count_threshold \
--kill-problem-processes=$kill_problem_processes \
$host"
$tree delete "cluster::$active_cluster"
Run::server $tree $host ""
destroy .add
}
}
proc Edit::infobases {tree host values} {
set work_tree_id [.frm_work.tree_work selection]
set work_tree_values [.frm_work.tree_work item $work_tree_id -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 "infobase" } {
set infobase [lindex $work_tree_values $i]
}
incr i
}
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
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set infobase $values
set frm [Add::infobases $tree $host $values]
$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 "Редактирование информационной базы"
#set active_cluster $values
label $frm.lbl_denied_from -text "Начало интервала времени действия\nрежима блокировки сеансов" \
-justify left -anchor nw
entry $frm.ent_denied_from
label $frm.lbl_denied_message -text "Cообщение, при попытке нарушения\nблокировки сеансов" \
-justify left -anchor nw
entry $frm.ent_denied_message
label $frm.lbl_denied_parameter -text "Параметр блокировки сеансов"
entry $frm.ent_denied_parameter
label $frm.lbl_denied_to -text "Конец интервала времени действия\nрежима блокировки сеансов" \
-justify left -anchor nw
entry $frm.ent_denied_to
label $frm.lbl_permission_code -text "Код разрешения начала сеанса\nвопреки блокировке сеансов" \
-justify left -anchor nw
entry $frm.ent_permission_code
label $frm.lbl_external_session_manager_connection_string \
-text "Параметры внешнего управления сеансами"
entry $frm.ent_external_session_manager_connection_string
label $frm.lbl_security_profile -text "Профиль безопасности информационной базы"
entry $frm.ent_security_profile
label $frm.lbl_safe_mode_security_profile_name -text "Профиль безопасности внешнего кода"
entry $frm.ent_safe_mode_security_profile_name
label $frm.lbl_sessions_deny -text "Режим блокировки сеансов"
checkbutton $frm.check_sessions_deny -variable sessions_deny -onvalue on -offvalue off
label $frm.lbl_external_session_manager_required -text "Внешнее управление сеансами"
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::$values "infobase info --cluster=$active_cluster --infobase=$values $host"]
FormFieldsDataInsert $frm $lst
.add.frm_btn.btn_ok configure -command {
RunCommand "" "infobase update \
--infobase=$infobase \
--infobase-user= \
--infobase-pwd= \
--dbms=$dbms \
--db-server=[.add.frm.ent_db_server get] \
--db-name=[.add.frm.ent_db_name get] \
--db-user=[.add.frm.ent_db_user get] \
--db-pwd=[.add.frm.ent_db_pwd get] \
--descr=[regsub -all -- " " [.add.frm.ent_descr get] "\\ "]\
--denied-from=[.add.frm.ent_denied_from get] \
--denied-message=[regsub -all -- " " [.add.frm.ent_denied_message get] "\\ "]\
--denied-parameter=[regsub -all -- " " [.add.frm.ent_denied_parameter get] "\\ "]\
--denied-to=[.add.frm.ent_denied_to get] \
--permission-code=[regsub -all -- " " [.add.frm.ent_permission_code get] "\\ "]\
--sessions-deny=$sessions_deny \
--scheduled-jobs-deny=$scheduled_jobs_deny \
--license-distribution=$license_distribution \
--external-session-manager-connection-string=[.add.frm.ent_external_session_manager_connection_string get] \
--external-session-manager-required=$external_session_manager_required \
--security-profile-name=[.add.frm.ent_security_profile get] \
--safe-mode-security-profile-name=[.add.frm.ent_safe_mode_security_profile_name get] \
--cluster=$active_cluster $auth $host"
#Run::infobases $tree $host $active_cluster
destroy .add
}
}
proc Edit::servers {tree host values} {
set work_tree_id [.frm_work.tree_work selection]
set work_tree_values [.frm_work.tree_work item $work_tree_id -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 "server" } {
set work_server [lindex $work_tree_values $i]
}
incr i
}
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
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]
$frm configure -text "Редактирование рабочего сервера"
set lst [RunCommand cluster::$values "server info --cluster=$active_cluster $auth --server=$server $host"]
FormFieldsDataInsert $frm $lst
$frm.lbl_agent_port configure -state disable
$frm.ent_agent_port configure -state disable
$frm.lbl_port_range configure -state disable
$frm.ent_port_range configure -state disable
$frm.lbl_name configure -state disable
$frm.ent_name configure -state disable
$frm.lbl_cluster_port configure -state disable
$frm.ent_cluster_port configure -state disable
.add.frm_btn.btn_ok configure -command {
RunCommand "" "server update \
--server=$server \
--using=$using \
--infobases-limit=[.add.frm.ent_infobases_limit get] \
--memory-limit=[.add.frm.ent_memory_limit get] \
--connections-limit=[.add.frm.ent_connections_limit get] \
--dedicate-managers=$dedicate_managers \
--safe-working-processes-memory-limit=[.add.frm.ent_safe_working_processes_memory_limit get] \
--safe-call-memory-limit=[.add.frm.ent_safe_call_memory_limit get] \
--cluster=$active_cluster $auth $host"
Run::servers $tree $host $active_cluster
destroy .add
}
}
proc Edit::rule {tree host values} {
global default active_cluster object_type infobase_name object_type server infobase_name rule_type rule \
agent_user agent_pwd cluster_user cluster_pwd
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set work_tree_id [.frm_work.tree_work selection]
set work_tree_values [.frm_work.tree_work item $work_tree_id -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 "rule" } {
set rule [lindex $work_tree_values $i]
}
incr i
}
if {[info exists rule] == 0 || $rule eq ""} {
return
}
set frm [Add::rule $tree $host $server]
$frm configure -text "Редактирование требования назначения функциональности"
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 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]
Del::$key $tree $host $values
}
namespace eval Del {} {}
proc Del::admin {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 ""
}
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 "Удалить администратора $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} {
global active_cluster
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 "name" } {
set admin_id [lindex $work_tree_values $i]
set tree .frm_work.tree_work
}
incr i
}
Del::admin $tree $host $admin_id
}
proc Del::agent_admin {tree host values} {
global 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 ""
}
set answer [tk_messageBox -message "Удалить администратора $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} {
global active_cluster
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 "name" } {
set admin_id [lindex $work_tree_values $i]
set tree .frm_work.tree_work
}
incr i
}
Del::agent_admin $tree $host $admin_id
}
proc Del::work_server {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 ""
}
set answer [tk_messageBox -message "Удалить рабочий сервер $values?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand infobase::$values "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} {
global active_cluster
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 "server" } {
set work_server_id [lindex $work_tree_values $i]
set tree .frm_work.tree_work
}
incr i
}
Del::work_server $tree $host $work_server_id
}
proc Del::cluster {tree host values} {
global 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 ""
}
set answer [tk_messageBox -message "Удалить кластер $values?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand infobase::$values "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
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 "Удалить информационную базу $values?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand infobase::$values "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} {
global active_cluster
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 "infobase" } {
set values [lindex $work_tree_values $i]
set tree .frm_work.tree_work
}
incr i
}
#puts "$tree $host $values"
Del::infobase $tree $host $values
}
proc Del::connections {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 ""
}
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 "connection" } {
set connection_id [lindex $work_tree_values $i]
}
if {$l eq "process" } {
set process_id [lindex $work_tree_values $i]
}
incr i
}
#puts "$connection_id $process_id"
set answer [tk_messageBox -message "Удалить соединение $connection_id?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand infobase::$values "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
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set work_tree_id [.frm_work.tree_work selection]
set work_tree_values [.frm_work.tree_work item $work_tree_id -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 "session" } {
set session_id [lindex $work_tree_values $i]
}
incr i
}
set answer [tk_messageBox -message "Прервать сессию $session_id?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand infobase::$values "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
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set work_tree_id [.frm_work.tree_work selection]
set work_tree_values [.frm_work.tree_work item $work_tree_id -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 "rule" } {
set rule_id [lindex $work_tree_values $i]
}
incr i
}
if {[info exists rule_id] == 0 || $rule_id eq ""} {
return
}
set answer [tk_messageBox -message "Удалить требование $rule_id?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand infobase::$values "rule remove --server=$server --rule=$rule_id --cluster=$active_cluster $auth $host"]
#$tree delete "infobase::$values"
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
}
no {return}
}
}
proc Del::server {tree host values} {
global dir
set answer [tk_messageBox -message "Удалить сервер $values?" \
-icon question -type yesno ]
switch -- $answer {
yes {
#set lst [RunCommand infobase::$values "cluster remove --cluster=$values $host"]
file copy [file join $dir(work) 1c_srv.cfg] [file join $dir(work) 1c_srv.cfg.bak]
set orig_file [open [file join $dir(work) 1c_srv.cfg.bak] "r"]
set file [open [file join $dir(work) 1c_srv.cfg] "w"]
while {[gets $orig_file line] >=0 } {
#puts $line
if { $line ne "" && $line ne "$values"} {
puts $file $line
}
}
close $file
close $orig_file
#return "$host:$port"
$tree delete "server::$values"
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
file delete [file join $dir(work) 1c_srv.cfg.bak]
}
no {return}
}
}
View Git Blame Copy Permalink