########################################### # 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 } proc TreePress {tree} { global host server set id [$tree selection] set values [$tree item [$tree selection] -values] set key [lindex [split $id "::"] 0] if {$key eq "server"} { set host $values } elseif {$key eq ""} { return } elseif {$key eq "work_server"} { set server $values } #puts "$id $host $values" Run::$key $tree $host $values #RunCommand $root "infobase summary list --cluster=$cluster $host" } 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 } } } 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 .frm_work.tree_work delete [ .frm_work.tree_work children {}] set lst [RunCommand infobase::$values "infobase summary --cluster=$active_cluster list $host"] 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 .frm_work.tree_work delete [ .frm_work.tree_work children {}] set lst [RunCommand infobase::$values "infobase info --cluster=$active_cluster --infobase=$values $host"] foreach l $lst { InsertItemsWorkList $l } } proc Run::List:Base {tree host values par} { global active_cluster .frm_work.tree_work delete [ .frm_work.tree_work children {}] set lst [RunCommand infobase::$values "$par list --cluster=$active_cluster --infobase=$values $host"] foreach l $lst { InsertItemsWorkList $l } } proc Run::List {tree host values par} { global active_cluster .frm_work.tree_work delete [ .frm_work.tree_work children {}] set lst [RunCommand infobase::$values "$par list --cluster=$active_cluster $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 .frm_work.tree_work delete [ .frm_work.tree_work children {}] set lst [RunCommand infobase::$values "server list --cluster=$active_cluster $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 .frm_work.tree_work delete [ .frm_work.tree_work children {}] set lst [RunCommand infobase::$values "server info --cluster=$active_cluster --server=$values $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 .frm_work.tree_work delete [ .frm_work.tree_work children {}] set lst [RunCommand work_server_processes::$values "process list --cluster=$active_cluster --server=$values $host"] foreach l $lst { InsertItemsWorkList $l } } proc Run::work_server_licenses {tree host values} { global active_cluster work_list_row_count .frm_work.tree_work delete [ .frm_work.tree_work children {}] set lst [RunCommand work_server_processes::$values "process list --cluster=$active_cluster --server=$values --licenses $host"] foreach l $lst { InsertItemsWorkList $l } } proc Run::managers {tree host values} { #Run::List $tree $host $values manager global active_cluster .frm_work.tree_work delete [ .frm_work.tree_work children {}] set lst [RunCommand cluster::$values "manager list --cluster=$active_cluster $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 .frm_work.tree_work delete [ .frm_work.tree_work children {}] set lst [RunCommand "" "service list --cluster=$active_cluster $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::admins {tree host values} { global active_cluster .frm_work.tree_work delete [ .frm_work.tree_work children {}] set lst [RunCommand infobase::$values "agent admin list $host"] foreach l $lst { InsertItemsWorkList $l } } proc Run::rule {tree host values} { global active_cluster .frm_work.tree_work delete [ .frm_work.tree_work children {}] set lst [RunCommand "" "rule list --cluster=$active_cluster --server=$values $host"] foreach l $lst { puts $l InsertItemsWorkList $l } } 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 puts "$rac_cmd $par" set work_list_row_count 0 set pipe [open "|$rac_cmd $par" "r"] set lst "" set l "" while {[gets $pipe line]>=0} { if {$line eq ""} { lappend l $lst set lst "" } else { lappend lst [string trim $line] } } close $pipe return $l # fileevent $pipe readable [list DebugInfo .frm_work.tree_work $pipe] # fconfigure $pipe -buffering none -blocking no } 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 DebugInfo {widget f} { if {[eof $f]} { catch [close $f] msg if {$msg != ""} { puts $msg } else { puts $msg } } while {[gets $f line]>=0} { puts "$line" $widget insert {} end -text "$line" -values "$line" } } 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::work_server {tree host values} { global active_cluster set answer [tk_messageBox -message "Удалить рабочий сервер $values?" \ -icon question -type yesno ] switch -- $answer { yes { set lst [RunCommand infobase::$values "server remove --cluster=$active_cluster --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} { set answer [tk_messageBox -message "Удалить кластер $values?" \ -icon question -type yesno ] switch -- $answer { yes { set lst [RunCommand infobase::$values "cluster remove --cluster=$values $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 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 $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 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 $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 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 $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 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 } 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 $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} } } 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 } namespace eval Add {} {} 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_manager using_central_server set dedicate_manager "none" set using_central_server "normal" #set active_cluster $values set frm [AddToplevel "Добавление рабочего сервера" server_grey_64] label $frm.lbl_server_desc -text "Описание сервера" entry $frm.ent_server_desc 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_ports_range -text "Диапазон портов" entry $frm.ent_ports_range $frm.ent_ports_range insert end $default(ports_range) label $frm.lbl_ram_max -text "Максимальный объём памяти раб. процессов" entry $frm.ent_ram_max $frm.ent_ram_max insert end $default(ram_max) label $frm.lbl_ram_sec -text "Безопасный расход памяти за вызов" entry $frm.ent_ram_sec $frm.ent_ram_sec insert end $default(ram_sec) label $frm.lbl_ram_work -text "Объём памяти рабочих процессов" entry $frm.ent_ram_work $frm.ent_ram_work insert end $default(ram_work) label $frm.lbl_base_on_process -text "Количество ИБ на процесс" entry $frm.ent_base_on_process $frm.ent_base_on_process insert end $default(base_on_process) label $frm.lbl_connection_on_process -text "Количество соединений на процесс" entry $frm.ent_connection_on_process $frm.ent_connection_on_process insert end $default(connection_on_process) label $frm.lbl_manager_port -text "Порт главного менеджера кластера" entry $frm.ent_manager_port $frm.ent_manager_port insert end $default(port) label $frm.lbl_manager_each_service -text "Менеджер под каждый сервис" checkbutton $frm.ent_manager_each_service -variable dedicate_manager -onvalue all -offvalue none label $frm.lbl_central_server -text "Центральный сервер" checkbutton $frm.ent_central_server -variable using_central_server -onvalue main -offvalue normal grid $frm.lbl_server_desc -row 0 -column 0 -sticky nw -padx 5 -pady 5 grid $frm.ent_server_desc -row 0 -column 1 -sticky nsew -padx 5 -pady 5 grid $frm.lbl_host -row 1 -column 0 -sticky nw -padx 5 -pady 5 grid $frm.ent_host -row 1 -column 1 -sticky nsew -padx 5 -pady 5 grid $frm.lbl_port -row 2 -column 0 -sticky nw -padx 5 -pady 5 grid $frm.ent_port -row 2 -column 1 -sticky nsew -padx 5 -pady 5 grid $frm.lbl_ports_range -row 3 -column 0 -sticky nw -padx 5 -pady 5 grid $frm.ent_ports_range -row 3 -column 1 -sticky nsew -padx 5 -pady 5 grid $frm.lbl_ram_max -row 4 -column 0 -sticky nw -padx 5 -pady 5 grid $frm.ent_ram_max -row 4 -column 1 -sticky nsew -padx 5 -pady 5 grid $frm.lbl_ram_sec -row 5 -column 0 -sticky nw -padx 5 -pady 5 grid $frm.ent_ram_sec -row 5 -column 1 -sticky nsew -padx 5 -pady 5 grid $frm.lbl_ram_work -row 6 -column 0 -sticky nw -padx 5 -pady 5 grid $frm.ent_ram_work -row 6 -column 1 -sticky nsew -padx 5 -pady 5 grid $frm.lbl_base_on_process -row 7 -column 0 -sticky nw -padx 5 -pady 5 grid $frm.ent_base_on_process -row 7 -column 1 -sticky nsew -padx 5 -pady 5 grid $frm.lbl_connection_on_process -row 8 -column 0 -sticky nw -padx 5 -pady 5 grid $frm.ent_connection_on_process -row 8 -column 1 -sticky nsew -padx 5 -pady 5 grid $frm.lbl_manager_port -row 9 -column 0 -sticky nw -padx 5 -pady 5 grid $frm.ent_manager_port -row 9 -column 1 -sticky nsew -padx 5 -pady 5 grid $frm.lbl_manager_each_service -row 10 -column 0 -sticky nw -padx 5 -pady 5 grid $frm.ent_manager_each_service -row 10 -column 1 -sticky nw -padx 5 -pady 5 grid $frm.lbl_central_server -row 11 -column 0 -sticky nw -padx 5 -pady 5 grid $frm.ent_central_server -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_host get] \ --agent-port=[.add.frm.ent_port get] \ --port-range=[.add.frm.ent_ports_range get] \ --name=[.add.frm.ent_server_desc get] \ --using=$using_central_server \ --infobases-limit=[.add.frm.ent_base_on_process get] \ --memory-limit=[.add.frm.ent_ram_work get] \ --connections-limit=[.add.frm.ent_connection_on_process get] \ --cluster-port=[.add.frm.ent_manager_port get] \ --dedicate-managers=$dedicate_manager \ --safe-working-processes-memory-limit=[.add.frm.ent_ram_max get] \ --safe-call-memory-limit=[.add.frm.ent_ram_sec get] \ --cluster=$active_cluster $host" Run::servers $tree $host $active_cluster destroy .add } } proc Add::work_server {tree host values} { Add::servers $tree $host $values } proc Add::infobase {tree host values} { Add::infobases $tree $host $values } proc Add::infobases {tree host values} { global default active_cluster global security_level dbms sheduled_jobs_deny create_db license_distribution date_offset db_create #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_pass -text "Пароль" entry $frm.ent_db_pass #$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_sheduled_jobs_deny -text "Блокировка регламентных заданий" checkbutton $frm.cb_sheduled_jobs_deny -variable sheduled_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_pass -row 7 -column 0 -sticky nw -padx 5 -pady 5 grid $frm.ent_db_pass -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_sheduled_jobs_deny -row 12 -column 0 -sticky nw -padx 5 -pady 5 grid $frm.cb_sheduled_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_pass get] \ --descr=\"[.add.frm.ent_descr get]\" \ --date-offset=$date_offset \ --security-level=$security_level \ --scheduled-jobs-deny=$sheduled_jobs \ --license-distribution=$license_distribution \ --cluster=$active_cluster $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 puts "$tree $host $values" 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 \ $host" Run::server $tree $host "" destroy .add } } proc Add::rule {tree host values} { global default active_cluster object infobase type server set server $values set frm [AddToplevel "Требование назначения функциональности" functional_grey_64] set type [lindex $default(type) 0] label $frm.lbl_object -text "Объект требования" set combo_object [ttk::combobox $frm.cb_object \ -textvariable object -values $default(object)] label $frm.lbl_type -text "Тип требования" set combo_type [ttk::combobox $frm.cb_type \ -textvariable type -values $default(type)] label $frm.lbl_infobase -text "Имя ИБ" set combo_infobase [ttk::combobox $frm.cb_infobase \ -textvariable infobase -values [GetInfobases $active_cluster $host]] label $frm.lbl_par -text "Значение доп. параметра" entry $frm.ent_par label $frm.lbl_priority -text "Приоритет" entry $frm.ent_priority $frm.ent_priority insert end $default(priority) grid $frm.lbl_object -row 0 -column 0 -sticky nw -padx 5 -pady 5 grid $frm.cb_object -row 0 -column 1 -sticky nsew -padx 5 -pady 5 grid $frm.lbl_type -row 1 -column 0 -sticky nw -padx 5 -pady 5 grid $frm.cb_type -row 1 -column 1 -sticky nsew -padx 5 -pady 5 grid $frm.lbl_infobase -row 2 -column 0 -sticky nw -padx 5 -pady 5 grid $frm.cb_infobase -row 2 -column 1 -sticky nsew -padx 5 -pady 5 grid $frm.lbl_par -row 3 -column 0 -sticky nw -padx 5 -pady 5 grid $frm.ent_par -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 \ --server=$server \ --position=0 \ --object-type=$object \ --infobase-name=$infobase \ --rule-type=$type \ --application-ext=[.add.frm.ent_par get] \ --priority=[.add.frm.ent_priority get] $host" Run::rule $tree $host $server destroy .add } } 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 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" } 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::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) 1c_srv.cfg.bak] destroy .add return $host } } proc Edit::cluster {tree host values} { global default lifetime_limit expiration_timeout session_fault_tolerance_level global max_memory_size max_memory_time_limit errors_count_threshold security_level global load_balancing_mode kill_problem_processes active_cluster Add::cluster $tree $host $values set active_cluster $values set lst [RunCommand cluster::$values "cluster info --cluster=$active_cluster $host"] 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 .add.frm.ent_$entry_name] { .add.frm.ent_$entry_name delete 0 end .add.frm.ent_$entry_name insert end [string trim $value "\""] } if [winfo exists .add.frm.cb_$entry_name] { set $entry_name [string trim $value "\""] } if [winfo exists .add.frm.check_$entry_name] { if {$value eq "0"} { set $entry_name no } elseif {$value eq "1"} { set $entry_name yes } } } } .add.frm.ent_host configure -state disable .add.frm.ent_port configure -state disable .add.frm_btn.btn_ok configure -command { RunCommand "" "cluster update \ --cluster=$active_cluster \ --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::infobase {tree host values} { global default active_cluster global secure_level dbms sheduled_jobs_deny create_db license_distribution date_offset db_create set frm [Add::infobases $tree $host $values] $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_sessions_deny -text "Режим блокировки сеансов" checkbutton $frm.cb_sessions_deny -variable sessions_deny -onvalue on -offvalue off label $frm.lbl_external_session_manager_connection_string \ -text "Параметры внешнего управления сеансами" checkbutton $frm.cb_external_session_manager_connection_string \ -variable external_session_manager_connection_string -onvalue yes -offvalue no label $frm.lbl_external_session_manager_required -text "Внешнее управление сеансами" checkbutton $frm.cb_external_session_manager_required \ -variable external_session_manager_required -onvalue yes -offvalue no label $frm.lbl_security_profile -text "Профиль безопасности информационной базы" entry $frm.ent_security_profile label $frm.lbl_safe_mode_security_profile -text "Профиль безопасности внешнего кода" entry $frm.ent_safe_mode_security_profile 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_sessions_deny -row 5 -column 2 -sticky nw -padx 5 -pady 5 grid $frm.cb_sessions_deny -row 5 -column 3 -sticky nw -padx 5 -pady 5 grid $frm.lbl_external_session_manager_required -row 6 -column 2 -sticky nw -padx 5 -pady 5 grid $frm.cb_external_session_manager_required -row 6 -column 3 -sticky nw -padx 5 -pady 5 grid $frm.lbl_external_session_manager_connection_string \ -row 7 -column 2 -sticky nw -padx 5 -pady 5 grid $frm.cb_external_session_manager_connection_string \ -row 7 -column 3 -sticky nw -padx 5 -pady 5 grid $frm.lbl_security_profile -row 8 -column 2 -sticky nw -padx 5 -pady 5 grid $frm.ent_security_profile -row 8 -column 3 -sticky nw -padx 5 -pady 5 grid $frm.lbl_safe_mode_security_profile -row 9 -column 2 -sticky nw -padx 5 -pady 5 grid $frm.ent_safe_mode_security_profile -row 9 -column 3 -sticky nw -padx 5 -pady 5 set lst [RunCommand infobase::$values "infobase info --cluster=$active_cluster --infobase=$values $host"] puts $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 .add.frm.ent_$entry_name] { .add.frm.ent_$entry_name delete 0 end .add.frm.ent_$entry_name insert end [string trim $value "\""] } if [winfo exists .add.frm.cb_$entry_name] { set $entry_name [string trim $value "\""] } if [winfo exists .add.frm.check_$entry_name] { if {$value eq "0"} { set $entry_name no } elseif {$value eq "1"} { set $entry_name yes } } } } .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_infobase_name get] \ --dbms=$dbms \ --db-server=[.add.frm.ent_host get] \ --db-name=[.add.frm.ent_base_name get] \ --locale=[.add.frm.ent_locale get] \ --db-user=[.add.frm.ent_db_user get] \ --db-pwd=[.add.frm.ent_db_pass get] \ --descr=\"[.add.frm.ent_infobase_descr get]\" \ --date-offset=$date_offset \ --security-level=$secure_level \ --scheduled-jobs-deny=$block_shedule \ --license-distribution=$license_distribution \ --cluster=$active_cluster $host" Run::infobases $tree $host $active_cluster destroy .add } }