rac-gui/lib/function.tcl

2276 lines
93 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]
if {$values eq "" || $key eq ""} {return}
Run::$key $tree $host $values
}
proc SetGlobalVarFromTreeItems {tree id} {
global host server active_cluster infobase profile_name
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}
profile {set profile_name $values}
}
if {$parent eq ""} {
return
} else {
SetGlobalVarFromTreeItems $tree $parent
}
}
proc InsertItemsWorkList {lst} {
global work_list_row_count
if [expr $work_list_row_count % 2] {
set tag 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 {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
return ""
#RunCommand $root $par
}
# fileevent $pipe readable [list DebugInfo .frm_work.tree_work $pipe]
# fconfigure $pipe -buffering none -blocking no
}
proc ErrorParcing {err opt} {
global cluster_user cluster_pwd agent_user agent_pwd
switch -regexp -- $err {
"Cluster administrator is not authenticated" {
AuthorisationDialog "Администратор кластера"
.auth_win.frm_btn.btn_ok configure -command {
set cluster_user [.auth_win.frm.ent_name get]
set cluster_pwd [.auth_win.frm.ent_pwd get]
destroy .auth_win
}
#RunCommand $root $par
}
"Central server administrator is not authenticated" {
AuthorisationDialog "Администратор агента кластера"
.auth_win.frm_btn.btn_ok configure -command {
set agent_user [.auth_win.frm.ent_name get]
set agent_pwd [.auth_win.frm.ent_pwd get]
destroy .auth_win
}
}
"Администратор кластера не аутентифицирован" {
AuthorisationDialog "Администратор кластера"
.auth_win.frm_btn.btn_ok configure -command {
set cluster_user [.auth_win.frm.ent_name get]
set cluster_pwd [.auth_win.frm.ent_pwd get]
destroy .auth_win
}
#RunCommand $root $par
}
"Администратор центрального сервера не аутентифицирован" {
AuthorisationDialog "Администратор агента кластера"
.auth_win.frm_btn.btn_ok configure -command {
set agent_user [.auth_win.frm.ent_name get]
set agent_pwd [.auth_win.frm.ent_pwd get]
destroy .auth_win
}
}
(.+) {
tk_messageBox -type ok -icon error -message "$err"
}
}
}
proc AuthorisationDialog {txt} {
global active_cluster agent_user agent_pwd cluster_user cluster_pwd
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set frm [AddToplevel "$txt" administrator_grey_64 .auth_win]
wm title .auth_win "Авторизация"
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 $id
}
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 InsertProfileItems {tree id} {
set parent "profile::$id"
set lst {
{directory "Виртуальные каталоги"}
{com "Разрешённые COM-классы"}
{addin "Внешние компоненты"}
{module "Внешние отчёты и обработки"}
{app "Разрешённые приложения"}
{inet "Ресурсы интернет"}
}
foreach i $lst {
append item [lindex $i 0] "::$id"
if { [$tree exists $item] == 0 } {
$tree insert $parent end -id $item -text [lindex $i 1] -values "$id"
}
unset item
}
}
proc GetInfobases {cluster host} {
global active_cluster cluster_user cluster_pwd auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set lst [RunCommand "infobase summary --cluster=$cluster $auth list $host"]
set return_list ""
foreach info_bases_list $lst {
foreach i $info_bases_list {
set i [split $i ":"]
if {[string trim [lindex $i 0]] eq "name"} {
lappend return_list [string trim [lindex $i 1]]
}
}
}
return $return_list
}
proc FormFieldsDataInsert {frm lst} {
foreach i [lindex $lst 0] {
if [regexp -nocase -all -- {(\D+)(\s*?|)(:)(\s*?|)(.*)} $i match param v2 v3 v4 value] {
regsub -all -- "-" [string trim $param] "_" entry_name
if [winfo exists $frm.ent_$entry_name] {
$frm.ent_$entry_name delete 0 end
$frm.ent_$entry_name insert end [string trim $value "\""]
}
if [winfo exists $frm.cb_$entry_name] {
global $entry_name
set $entry_name [string trim $value "\""]
}
if [winfo exists $frm.check_$entry_name] {
global $entry_name
if {$value eq "0"} {
set $entry_name no
} elseif {$value eq "1"} {
set $entry_name yes
} else {
set $entry_name $value
}
}
}
}
}
proc SaveMainServer {host port} {
global dir
set file [open [file join $dir(work) 1c_srv.cfg] "a+"]
puts $file "$host:$port"
close $file
return "$host:$port"
}
proc GetWorkTreeItems {par} {
set work_tree_id [.frm_work.tree_work selection]
set work_tree_values [.frm_work.tree_work item $work_tree_id -values]
#puts ">$work_tree_id >$work_tree_values"
set id [.frm_tree.tree selection]
#set values [.frm_tree.tree item $id -values]
set key [lindex [split $id "::"] 0]
set column_list [.frm_work.tree_work cget -columns]
set i 0
# проверка соответсвия колонки в таблице и ключа в дереве
foreach l $column_list {
if {$l eq $par } {
set item_id [lindex $work_tree_values $i]
set tree .frm_work.tree_work
}
incr i
}
return $item_id
}
proc GetWorkTreeRow {} {
set work_tree_id [.frm_work.tree_work selection]
#puts "$work_tree_id"
set work_tree_values_list [.frm_work.tree_work item $work_tree_id -values]
set column_list [.frm_work.tree_work cget -columns]
set l1 [llength $column_list]
set l2 [llength $work_tree_values_list]
if {$l1 == $l2} {
for {set i 0} {$i <= $l1 } {incr i} {
lappend lst "[lindex $column_list $i] : [lindex $work_tree_values_list $i]"
}
} else {
return
}
return $lst
}
namespace eval Run {} {}
# Получение данных по кластерам
proc Run::server {tree host values} {
set lst [RunCommand "cluster list $host"]
if {$lst eq ""} {return}
set l [lindex $lst 0]
#puts $lst
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
foreach cluster_list $lst {
InsertItemsWorkList $cluster_list
foreach i $cluster_list {
#puts $i
set cluster_list [split $i ":"]
if {[string trim [lindex $cluster_list 0]] eq "cluster"} {
set cluster_id [string trim [lindex $cluster_list 1]]
lappend cluster($cluster_id) $cluster_id
}
if {[string trim [lindex $cluster_list 0]] eq "name"} {
lappend cluster($cluster_id) [string trim [lindex $cluster_list 1]]
}
}
}
foreach x [array names cluster] {
set id [lindex $cluster($x) 0]
if { [$tree exists "cluster::$id"] == 0 } {
$tree insert "server::$host" end -id "cluster::$id" -text "[lindex $cluster($x) 1]" -values "$id"
InsertClusterItems $tree $id
}
}
if { [$tree exists "agent_admins::$id"] == 0 } {
$tree insert "server::$host" end -id "agent_admins::$id" -text "Администраторы" -values "$id"
#InsertClusterItems $tree $id
}
}
proc Run::cluster {tree host values} {
global active_cluster
set active_cluster $values
RunCommand "cluster info --cluster=$values $host"
}
proc Run::cluster_managers {tree host values} {
}
proc Run::services {tree host values} {
global active_cluster
Run::List $tree $host $active_cluster service
}
proc Run::infobases {tree host values} {
global active_cluster cluster_user cluster_pwd
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set lst [RunCommand "infobase summary --cluster=$active_cluster $auth list $host"]
puts $lst
foreach info_bases_list $lst {
foreach i $info_bases_list {
set base_list [split $i ":"]
if {[string trim [lindex $base_list 0]] eq "infobase"} {
set base_id [string trim [lindex $base_list 1]]
lappend base($base_id) $base_id
}
if {[string trim [lindex $base_list 0]] eq "name"} {
lappend base($base_id) [string trim [lindex $base_list 1]]
}
#InsertItemsWorkList $base_list
}
InsertItemsWorkList $info_bases_list
}
foreach x [array names base] {
set id [lindex $base($x) 0]
if { [$tree exists "infobase::$id"] == 0 } {
$tree insert "infobases::$values" end -id "infobase::$id" -text "[lindex $base($x) 1]" -values "$id"
}
InsertBaseItems $tree $id
}
}
proc Run::infobase {tree host values} {
global active_cluster cluster_user cluster_pwd
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 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 "$par list --cluster=$active_cluster $auth --infobase=$values $host"]
foreach l $lst {
InsertItemsWorkList $l
}
}
proc Run::List {tree host values par} {
global active_cluster cluster_user cluster_pwd
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand "$par list --cluster=$active_cluster $auth $host"]
foreach l $lst {
InsertItemsWorkList $l
}
}
proc Run::sessions {tree host values} {
Run::List:Base $tree $host $values session
}
proc Run::locks {tree host values} {
Run::List:Base $tree $host $values lock
}
proc Run::connections {tree host values} {
Run::List:Base $tree $host $values connection
}
proc Run::servers {tree host values} {
global active_cluster cluster_user cluster_pwd
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set lst [RunCommand "server list --cluster=$active_cluster $auth $host"]
if {$lst eq ""} {return}
foreach l $lst {
foreach i $l {
set server_list [split $i ":"]
#InsertItemsWorkList $server_list
if {[string trim [lindex $server_list 0]] eq "server"} {
set server_id [string trim [lindex $server_list 1]]
lappend server($server_id) $server_id
}
if {[string trim [lindex $server_list 0]] eq "name"} {
lappend server($server_id) [string trim [lindex $server_list 1]]
}
}
#puts $l
InsertItemsWorkList $l
}
foreach x [array names server] {
set id [lindex $server($x) 0]
if { [$tree exists "work_server::$id"] == 0 } {
$tree insert "servers::$values" end -id "work_server::$id" \
-text "[lindex $server($x) 1]" -values "$id"
}
InsertWorkServerItems $tree $id
}
#Run::List $tree $host $values server
}
proc Run::work_server {tree host values} {
global active_cluster work_list_row_count cluster_user cluster_pwd
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand "server info --cluster=$active_cluster --server=$values $auth $host"]
foreach l $lst {
InsertItemsWorkList $l
}
}
proc Run::profile {tree host values} {
return
}
proc Run::profiles {tree host values} {
global active_cluster work_list_row_count cluster_user cluster_pwd
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand "profile list --cluster=$active_cluster $auth $host"]
foreach l $lst {
foreach i $l {
set profile_list [split $i ":"]
#InsertItemsWorkList $server_list
if {[string trim [lindex $profile_list 0]] eq "name"} {
set profile_name [string trim [lindex $profile_list 1]]
lappend profiles($profile_name) $profile_name
}
}
#puts $l
InsertItemsWorkList $l
}
foreach x [array names profiles] {
set id [lindex $profiles($x) 0]
if { [$tree exists "profile::$id"] == 0 } {
$tree insert "profiles::$values" end -id "profile::$id" \
-text $id -values "$id"
}
InsertProfileItems $tree $id
}
}
proc Run::processes {tree host values} {
Run::List $tree $host $values process
}
proc Run::work_server_processes {tree host values} {
global active_cluster work_list_row_count cluster_user cluster_pwd
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand "process list --cluster=$active_cluster $auth --server=$values $host"]
foreach l $lst {
InsertItemsWorkList $l
}
}
proc Run::work_server_licenses {tree host values} {
global active_cluster work_list_row_count cluster_user cluster_pwd
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand "process list --cluster=$active_cluster $auth --server=$values --licenses $host"]
foreach l $lst {
InsertItemsWorkList $l
}
}
proc Run::managers {tree host values} {
#Run::List $tree $host $values manager
global active_cluster work_list_row_count cluster_user cluster_pwd
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand "manager list --cluster=$active_cluster $auth $host"]
foreach l $lst {
foreach i $l {
set server_list [split $i ":"]
#InsertItemsWorkList $server_list
if {[string trim [lindex $server_list 0]] eq "manager"} {
set server_id [string trim [lindex $server_list 1]]
lappend server($server_id) $server_id
}
if {[string trim [lindex $server_list 0]] eq "host"} {
lappend server($server_id) [string trim [lindex $server_list 1]]
}
}
#puts $l
InsertItemsWorkList $l
}
foreach x [array names server] {
set id [lindex $server($x) 0]
if { [$tree exists "manager::$id"] == 0 } {
$tree insert "managers::$values" end -id "manager::$id" \
-text "[lindex $server($x) 1]" -values "$id"
}
#InsertWorkServerItems $tree $id
}
#Run::List $tree $host $values server
}
proc Run::manager {tree host values} {
#Run::List $tree $host $values service
global active_cluster cluster_user cluster_pwd
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand "service list --cluster=$active_cluster $auth $host"]
foreach l $lst {
#puts $l
foreach i $l {
set temp_lst [split $i ":"]
if {[string trim [lindex $temp_lst 0]] eq "manager" && [string match "*$values*" [string trim [lindex $temp_lst 1]]] == 1 } {
InsertItemsWorkList $l
}
}
}
}
proc Run::agent_admin {tree host values} {
Run::admins $tree $host $values
}
proc Run::agent_admins {tree host values} {
global active_cluster agent_user agent_pwd
if {$agent_user ne "" && $agent_pwd ne ""} {
set agent_auth "--agent-user=$agent_user --agent-pwd=$agent_pwd"
} else {
set agent_auth ""
}
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand "agent admin list $agent_auth $host"]
foreach l $lst {
InsertItemsWorkList $l
}
}
proc Run::admins {tree host values} {
global active_cluster agent_user agent_pwd cluster_user cluster_pwd
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [
RunCommand "cluster admin list $auth --cluster=$active_cluster $host"
]
foreach l $lst {
InsertItemsWorkList $l
}
}
proc Run::rule {tree host values} {
global active_cluster cluster_user cluster_pwd
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand "rule list --cluster=$active_cluster $auth --server=$values $host"]
foreach l $lst {
#puts $l
InsertItemsWorkList $l
}
}
proc Run::directory {tree host values} {
Run::acl $host $values directory
}
proc Run::com {tree host values} {
Run::acl $host $values com
}
proc Run::addin {tree host values} {
Run::acl $host $values addin
}
proc Run::module {tree host values} {
Run::acl $host $values module
}
proc Run::app {tree host values} {
Run::acl $host $values app
}
proc Run::inet {tree host values} {
Run::acl $host $values inet
}
proc Run::acl {host values mode} {
global active_cluster cluster_user cluster_pwd profile_name
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
set lst [RunCommand "profile acl $mode list --cluster=$active_cluster --name=$profile_name $auth $host"]
foreach l $lst {
#puts $l
InsertItemsWorkList $l
}
}
proc Add {} {
global active_cluster host
set id [.frm_tree.tree selection]
set values [.frm_tree.tree item [.frm_tree.tree selection] -values]
set key [lindex [split $id "::"] 0]
if {$key eq "" || $key eq "server"} {
set host [ Add::server ]
return
}
#puts "$key, $id , $values"
Add::$key .frm_tree.tree $host $values
}
proc AddToplevel {lbl img {win_name .add}} {
set cmd "destroy $win_name"
if [winfo exists $win_name] {destroy $win_name}
toplevel $win_name
wm title $win_name $lbl
wm iconphoto $win_name tcl
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 auth
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::manager {tree host values} {
return
}
proc Add::managers {tree host values} {
return
}
proc Add::infobase {tree host values} {
return [Add::infobases $tree $host $values]
}
proc Add::infobases {tree host values} {
global default active_cluster agent_user agent_pwd cluster_user cluster_pwd auth
global security_level dbms scheduled_jobs_deny create_db license_distribution date_offset db_create
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
#set active_cluster $values
# установка значений по умолчанию
set license_distribution deny
set security_level [lindex $default(security_level) 0]
set date_offset [lindex $default(date_offset) 0]
set dbms [lindex $default(dbms) 0]
set block_shedule on
set frm [AddToplevel "Добавление информационной базы" 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(security_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=[regsub -all -- " " [.add.frm.ent_descr get] "\\ "] \
--date-offset=$date_offset \
--security-level=$security_level \
--scheduled-jobs-deny=$scheduled_jobs_deny \
--license-distribution=$license_distribution \
--cluster=$active_cluster $auth $host"
Run::infobases $tree $host $active_cluster
destroy .add
}
return $frm
}
proc Add::cluster {tree host values} {
global default lifetime_limit expiration_timeout session_fault_tolerance_level
global max_memory_size max_memory_time_limit errors_count_threshold security_level
global load_balancing_mode kill_problem_processes \
agent_user agent_pwd cluster_user cluster_pwd auth_agent
if {$agent_user ne "" && $agent_pwd ne ""} {
set auth_agent "--agent-user=$agent_user --agent-pwd=$agent_pwd"
} else {
set auth_agent ""
}
set lifetime_limit $default(lifetime_limit)
set expiration_timeout $default(expiration_timeout)
set session_fault_tolerance_level $default(session_fault_tolerance_level)
set max_memory_size $default(max_memory_size)
set max_memory_time_limit $default(max_memory_time_limit)
set errors_count_threshold $default(errors_count_threshold)
set security_level [lindex $default(security_level) 0]
set load_balancing_mode [lindex $default(load_balancing_mode) 0]
set frm [AddToplevel "Добавление кластера" 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(security_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 auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set server $values
set frm [AddToplevel "Требование назначения функциональности" 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 Add::profiles {tree host values} {
Add::profile $tree $host $values
}
proc Add::profile {tree host values} {
global default active_cluster server agent_user agent_pwd cluster_user cluster_pwd auth
global config priv crypto right_extension right_extension_definition_roles \
all_modules_extension modules_available_for_extension modules_not_available_for_extension
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set var_list {config priv crypto right_extension all_modules_extension }
foreach v $var_list {set $v "off"; puts $v}
set var_list {right_extension_definition_roles modules_available_for_extension modules_not_available_for_extension}
foreach v $var_list {set $v 0; puts $v}
unset var_list
puts ">>>$right_extension_definition_roles"
set frm [AddToplevel "Профиль безопасности" security_grey_64]
label $frm.lbl_name -text "Имя профиля"
entry $frm.ent_name
label $frm.lbl_descr -text "Описание"
entry $frm.ent_descr
label $frm.lbl_config -justify left -anchor nw -text "Использование профиля из конфигурации"
checkbutton $frm.check_config -variable config -onvalue yes -offvalue no
label $frm.lbl_priv -justify left -anchor nw -text "Привилегированный режим"
checkbutton $frm.check_priv -variable priv -onvalue yes -offvalue no
label $frm.lbl_crypto -justify left -anchor nw -text "Разрешено использование криптографии"
checkbutton $frm.check_crypto -variable crypto -onvalue yes -offvalue no
label $frm.lbl_right_extension -justify left -anchor nw -text "Любое расширение прав доступа"
checkbutton $frm.check_right_extension -variable right_extension -onvalue yes -offvalue no
label $frm.lbl_right_extension_definition_roles -justify left -anchor nw -text "Роли, ограничивающие расширение прав доступа"
ttk::combobox $frm.cb_right_extension_definition_roles -textvariable right_extension_definition_roles
label $frm.lbl_all_modules_extension -justify left -anchor nw -text "Расширение всех модулей"
checkbutton $frm.check_all_modules_extension -variable all_modules_extension -onvalue yes -offvalue no
label $frm.lbl_modules_available_for_extension -text "Доступные для расширения модули"
ttk::combobox $frm.cb_modules_available_for_extension -textvariable modules_available_for_extension
label $frm.lbl_modules_not_available_for_extension -text "Недоступные для расширения модули"
ttk::combobox $frm.cb_modules_not_available_for_extension -textvariable modules_not_available_for_extension
grid $frm.lbl_name -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_descr -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_descr -row 1 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_config -row 2 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.check_config -row 2 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_priv -row 3 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.check_priv -row 3 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_crypto -row 4 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.check_crypto -row 4 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_right_extension -row 5 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.check_right_extension -row 5 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_right_extension_definition_roles -row 6 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_right_extension_definition_roles -row 6 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_all_modules_extension -row 7 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.check_all_modules_extension -row 7 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_modules_available_for_extension -row 8 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_modules_available_for_extension -row 8 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_modules_not_available_for_extension -row 9 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_modules_not_available_for_extension -row 9 -column 1 -sticky nsew -padx 5 -pady 5
.add.frm_btn.btn_ok configure -command {
RunCommand "profile update \
--cluster=$active_cluster $auth \
--name=[.add.frm.ent_name get] \
--descr=[regsub -all -- " " [.add.frm.ent_descr get] "\\ "] \
--config=$config \
--priv=$priv \
--crypto=$crypto \
--right-extension=$right_extension \
--right-extension-definition-roles=$right_extension_definition_roles \
--all-modules-extension=$all_modules_extension \
--modules-available-for-extension=$modules_available_for_extension \
--modules-not-available-for-extension=$modules_not_available_for_extension \
$host"
Run::profiles $tree $host $active_cluster
destroy .add
}
return $frm
}
proc Add::directory {tree host values} {
global default active_cluster profile_name agent_user agent_pwd cluster_user cluster_pwd auth
global
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set var_list {allowedRead allowedWrite}
foreach v $var_list {set $v "no"; puts $v}
unset var_list
set frm [AddToplevel "Виртуальный каталог" directory_grey_64]
label $frm.lbl_alias -text "Логический URL"
entry $frm.ent_alias
label $frm.lbl_descr -text "Описание"
entry $frm.ent_descr
label $frm.lbl_physicalPath -justify left -anchor nw -text "Физический URL"
entry $frm.ent_physicalPath
label $frm.lbl_allowedRead -justify left -anchor nw -text "Разрешено чтение данных"
checkbutton $frm.check_allowedRead -variable allowedRead -onvalue yes -offvalue no
label $frm.lbl_allowedWrite -justify left -anchor nw -text "Разрешена запись данных"
checkbutton $frm.check_allowedWrite -variable allowedWrite -onvalue yes -offvalue no
grid $frm.lbl_alias -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_alias -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_descr -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_descr -row 1 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_physicalPath -row 2 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_physicalPath -row 2 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_allowedRead -row 3 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.check_allowedRead -row 3 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_allowedWrite -row 4 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.check_allowedWrite -row 4 -column 1 -sticky nw -padx 5 -pady 5
.add.frm_btn.btn_ok configure -command {
RunCommand "profile --cluster=$active_cluster $auth \
acl --name=$profile_name \
directory update \
\"--alias=[regsub -all -- " " [.add.frm.ent_alias get] "\\ "]\" \
\"--descr=[regsub -all -- " " [.add.frm.ent_descr get] "\\ "]\" \
\"--physicalPath=[regsub -all -- " " [.add.frm.ent_physicalPath get] "\\ "]\" \
--allowedRead=$allowedRead \
--allowedWrite=$allowedWrite \
$host"
Run::directory $tree $host $profile_name
destroy .add
}
return $frm
}
proc Add::addin {tree host values} {
global default active_cluster profile_name agent_user agent_pwd cluster_user cluster_pwd auth
global
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set var_list {allowedRead allowedWrite}
foreach v $var_list {set $v "no"; puts $v}
unset var_list
set frm [AddToplevel "Внешняя компонента" addin_grey_64]
label $frm.lbl_name -text "Имя"
entry $frm.ent_name
label $frm.lbl_descr -text "Описание"
entry $frm.ent_descr
label $frm.lbl_hash -justify left -anchor nw -text "Контрольная сумма"
entry $frm.ent_hash
grid $frm.lbl_name -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_descr -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_descr -row 1 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_hash -row 2 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_hash -row 2 -column 1 -sticky nw -padx 5 -pady 5
.add.frm_btn.btn_ok configure -command {
RunCommand "profile --cluster=$active_cluster $auth \
acl --name=$profile_name \
addin update \
\"--name=[regsub -all -- " " [.add.frm.ent_name get] "\\ "]\" \
\"--descr=[regsub -all -- " " [.add.frm.ent_descr get] "\\ "]\" \
--hash=[.add.frm.ent_hash get] \
$host"
Run::addin $tree $host $profile_name
destroy .add
}
return $frm
}
proc Add::module {tree host values} {
global default active_cluster profile_name agent_user agent_pwd cluster_user cluster_pwd auth
global
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set var_list {allowedRead allowedWrite}
foreach v $var_list {set $v "no"; puts $v}
unset var_list
set frm [AddToplevel "Внешний отчёт или обработка" module_grey_64]
label $frm.lbl_name -text "Имя"
entry $frm.ent_name
label $frm.lbl_descr -text "Описание"
entry $frm.ent_descr
label $frm.lbl_hash -justify left -anchor nw -text "Контрольная сумма"
entry $frm.ent_hash
grid $frm.lbl_name -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_descr -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_descr -row 1 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_hash -row 2 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_hash -row 2 -column 1 -sticky nw -padx 5 -pady 5
.add.frm_btn.btn_ok configure -command {
RunCommand "profile --cluster=$active_cluster $auth \
acl --name=$profile_name \
module update \
\"--name=[regsub -all -- " " [.add.frm.ent_name get] "\\ "]\" \
\"--descr=[regsub -all -- " " [.add.frm.ent_descr get] "\\ "]\" \
--hash=[.add.frm.ent_hash get] \
$host"
Run::module $tree $host $profile_name
destroy .add
}
return $frm
}
proc Add::com {tree host values} {
global default active_cluster profile_name agent_user agent_pwd cluster_user cluster_pwd auth
global
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set var_list {allowedRead allowedWrite}
foreach v $var_list {set $v "no"; puts $v}
unset var_list
set frm [AddToplevel "COM-класс" com_grey_64]
label $frm.lbl_name -text "Имя"
entry $frm.ent_name
label $frm.lbl_descr -text "Описание"
entry $frm.ent_descr
label $frm.lbl_fileName -justify left -anchor nw -text "Файл (моникер)"
entry $frm.ent_fileName
label $frm.lbl_id -justify left -anchor nw -text "Идентификатор COM-класса"
entry $frm.ent_id
label $frm.lbl_host -justify left -anchor nw -text "Компьютер COM-объекта"
entry $frm.ent_host
grid $frm.lbl_name -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_descr -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_descr -row 1 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_fileName -row 2 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_fileName -row 2 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_id -row 3 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_id -row 3 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_host -row 4 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_host -row 4 -column 1 -sticky nw -padx 5 -pady 5
.add.frm_btn.btn_ok configure -command {
RunCommand "profile --cluster=$active_cluster $auth \
acl --name=$profile_name com update \
\"--name=[regsub -all -- " " [.add.frm.ent_name get] "\\ "]\" \
\"--descr=[regsub -all -- " " [.add.frm.ent_descr get] "\\ "]\" \
\"--fileName=[regsub -all -- " " [.add.frm.ent_fileName get] "\\ "]\" \
--id=[.add.frm.ent_id get] \
--host=[.add.frm.ent_host get] \
$host"
Run::com $tree $host $profile_name
destroy .add
}
return $frm
}
proc Add::app {tree host values} {
global default active_cluster profile_name agent_user agent_pwd cluster_user cluster_pwd auth
global
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set var_list {allowedRead allowedWrite}
foreach v $var_list {set $v "no"; puts $v}
unset var_list
set frm [AddToplevel "Разрешённое приложения" app_grey_64]
label $frm.lbl_name -text "Имя приложения"
entry $frm.ent_name
label $frm.lbl_descr -text "Описание"
entry $frm.ent_descr
label $frm.lbl_wild -justify left -anchor nw -text "Шаблон строки запуска"
entry $frm.ent_wild
grid $frm.lbl_name -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_descr -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_descr -row 1 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_wild -row 2 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_wild -row 2 -column 1 -sticky nw -padx 5 -pady 5
.add.frm_btn.btn_ok configure -command {
RunCommand "profile --cluster=$active_cluster $auth \
acl --name=$profile_name app update \
\"--name=[regsub -all -- " " [.add.frm.ent_name get] "\\ "]\" \
\"--descr=[regsub -all -- " " [.add.frm.ent_descr get] "\\ "]\" \
\"--wild=[regsub -all -- " " [.add.frm.ent_wild get] "\\ "]\" \
$host"
Run::app $tree $host $profile_name
destroy .add
}
return $frm
}
proc Add::inet {tree host values} {
global default active_cluster profile_name agent_user agent_pwd cluster_user cluster_pwd auth
global
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set var_list {allowedRead allowedWrite}
foreach v $var_list {set $v "no"; puts $v}
unset var_list
set frm [AddToplevel "Ресурс интернет" link_grey_64]
label $frm.lbl_name -text "Имя ресурса"
entry $frm.ent_name
label $frm.lbl_descr -text "Описание"
entry $frm.ent_descr
label $frm.lbl_protocol -justify left -anchor nw -text "Протокол"
entry $frm.ent_protocol
label $frm.lbl_url -justify left -anchor nw -text "Адрес (URL)"
entry $frm.ent_url
label $frm.lbl_port -justify left -anchor nw -text "Порт"
entry $frm.ent_port
$frm.ent_port insert end 0
grid $frm.lbl_name -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_descr -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_descr -row 1 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_protocol -row 2 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_protocol -row 2 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_url -row 3 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_url -row 3 -column 1 -sticky nw -padx 5 -pady 5
grid $frm.lbl_port -row 4 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_port -row 4 -column 1 -sticky nw -padx 5 -pady 5
.add.frm_btn.btn_ok configure -command {
RunCommand "profile --cluster=$active_cluster $auth \
acl --name=$profile_name inet update \
\"--name=[regsub -all -- " " [.add.frm.ent_name get] "\\ "]\" \
\"--descr=[regsub -all -- " " [.add.frm.ent_descr get] "\\ "]\" \
--protocol=[.add.frm.ent_protocol get] \
\"--url=[regsub -all -- " " [.add.frm.ent_url get] "\\ "]\" \
--port=[.add.frm.ent_port get] \
$host"
Run::inet $tree $host $profile_name
destroy .add
}
return $frm
}
proc 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]
if {$values eq "" || $key eq ""} {return}
Edit::$key $tree $host $values
}
namespace eval Edit {} {}
proc Edit::admins {tree host value} {
return
}
proc Edit::manager {tree host values} {
return
}
proc Edit::managers {tree host values} {
return
}
proc Edit::server {tree host value} {
global dir prev_address
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 auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set frm [Add::cluster $tree $host $values]
$frm configure -text "Редактирование кластера"
set active_cluster $values
set lst [RunCommand "cluster info --cluster=$active_cluster $host"]
FormFieldsDataInsert $frm $lst
$frm.ent_host configure -state disable
$frm.ent_port configure -state disable
.add.frm_btn.btn_ok configure -command {
RunCommand "cluster update \
--cluster=$active_cluster $auth \
--name=[.add.frm.ent_name get] \
--expiration-timeout=$expiration_timeout \
--lifetime-limit=$lifetime_limit \
--max-memory-size=$max_memory_size \
--max-memory-time-limit=$max_memory_time_limit \
--security-level=$security_level \
--session-fault-tolerance-level=$session_fault_tolerance_level \
--load-balancing-mode=$load_balancing_mode \
--errors-count-threshold=$errors_count_threshold \
--kill-problem-processes=$kill_problem_processes \
$auth $host"
$tree delete "cluster::$active_cluster"
Run::server $tree $host ""
destroy .add
}
}
proc Edit::infobases {tree host values} {
set infobase [GetWorkTreeItems "infobase"]
if {[info exists infobase] == 0 || $infobase eq ""} {
return
}
Edit::infobase $tree $host $infobase
}
proc Edit::infobase {tree host values} {
global default active_cluster infobase agent_user agent_pwd cluster_user cluster_pwd
global security_level dbms scheduled_jobs_deny license_distribution date_offset
global sessions_deny auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set infobase $values
set frm [Add::infobases $tree $host $values]
$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 info --cluster=$active_cluster --infobase=$values $auth $host"]
FormFieldsDataInsert $frm $lst
.add.frm_btn.btn_ok configure -command {
RunCommand "infobase update \
--infobase=$infobase \
--infobase-user= \
--infobase-pwd= \
--dbms=$dbms \
--db-server=[.add.frm.ent_db_server get] \
--db-name=[.add.frm.ent_db_name get] \
--db-user=[.add.frm.ent_db_user get] \
--db-pwd=[.add.frm.ent_db_pwd get] \
--descr=[regsub -all -- " " [.add.frm.ent_descr get] "\\ "]\
--denied-from=[.add.frm.ent_denied_from get] \
--denied-message=[regsub -all -- " " [.add.frm.ent_denied_message get] "\\ "]\
--denied-parameter=[regsub -all -- " " [.add.frm.ent_denied_parameter get] "\\ "]\
--denied-to=[.add.frm.ent_denied_to get] \
--permission-code=[regsub -all -- " " [.add.frm.ent_permission_code get] "\\ "]\
--sessions-deny=$sessions_deny \
--scheduled-jobs-deny=$scheduled_jobs_deny \
--license-distribution=$license_distribution \
--external-session-manager-connection-string=[.add.frm.ent_external_session_manager_connection_string get] \
--external-session-manager-required=$external_session_manager_required \
--security-profile-name=[.add.frm.ent_security_profile get] \
--safe-mode-security-profile-name=[.add.frm.ent_safe_mode_security_profile_name get] \
--cluster=$active_cluster $auth $host"
#Run::infobases $tree $host $active_cluster
destroy .add
}
}
proc Edit::servers {tree host values} {
set work_server [GetWorkTreeItems "server"]
if {[info exists work_server] == 0 || $work_server eq ""} {
return
}
Edit::work_server $tree $host $work_server
}
proc Edit::work_server {tree host values} {
global default active_cluster agent_user agent_pwd cluster_user cluster_pwd
global default dedicate_managers using auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set server $values
set frm [Add::work_server $tree $host $values]
$frm configure -text "Редактирование рабочего сервера"
set lst [RunCommand "server info --cluster=$active_cluster $auth --server=$server $host"]
FormFieldsDataInsert $frm $lst
$frm.lbl_agent_port configure -state disable
$frm.ent_agent_port configure -state disable
$frm.lbl_port_range configure -state disable
$frm.ent_port_range configure -state disable
$frm.lbl_name configure -state disable
$frm.ent_name configure -state disable
$frm.lbl_cluster_port configure -state disable
$frm.ent_cluster_port configure -state disable
.add.frm_btn.btn_ok configure -command {
RunCommand "server update \
--server=$server \
--using=$using \
--infobases-limit=[.add.frm.ent_infobases_limit get] \
--memory-limit=[.add.frm.ent_memory_limit get] \
--connections-limit=[.add.frm.ent_connections_limit get] \
--dedicate-managers=$dedicate_managers \
--safe-working-processes-memory-limit=[.add.frm.ent_safe_working_processes_memory_limit get] \
--safe-call-memory-limit=[.add.frm.ent_safe_call_memory_limit get] \
--cluster=$active_cluster $auth $host"
Run::servers $tree $host $active_cluster
destroy .add
}
}
proc Edit::rule {tree host values} {
global default active_cluster object_type infobase_name object_type server infobase_name rule_type rule \
agent_user agent_pwd cluster_user cluster_pwd auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set rule [GetWorkTreeItems "rule"]
if {[info exists rule] == 0 || $rule eq ""} {
return
}
set frm [Add::rule $tree $host $server]
$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 Edit::profile {tree host values} {
global default active_cluster server agent_user agent_pwd cluster_user cluster_pwd auth
global config priv crypto right_extension right_extension_definition_roles \
all_modules_extension modules_available_for_extension modules_not_available_for_extension
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set frm [Add::profile $tree $host $values]
$frm configure -text "Редактирование профиля безопасности: $values"
set work_tree_id [.frm_work.tree_work selection]
puts "$work_tree_id"
set work_tree_values_list [.frm_work.tree_work item $work_tree_id -values]
set column_list [.frm_work.tree_work cget -columns]
set l1 [llength $column_list]
set l2 [llength $work_tree_values_list]
if {$l1 == $l2} {
for {set i 0} {$i <= $l1 } {incr i} {
lappend lst "[lindex $column_list $i] : [lindex $work_tree_values_list $i]"
}
} else {
return
}
FormFieldsDataInsert $frm [list $lst]
.add.frm.ent_name configure -state disable
.add.frm_btn.btn_ok configure -command {
RunCommand "profile update \
--cluster=$active_cluster $auth \
--name=[.add.frm.ent_name get] \
\"--descr=[regsub -all -- " " [.add.frm.ent_descr get] "\\ "]\" \
--config=$config \
--priv=$priv \
--crypto=$crypto \
--right-extension=$right_extension \
--right-extension-definition-roles=$right_extension_definition_roles \
--all-modules-extension=$all_modules_extension \
--modules-available-for-extension=$modules_available_for_extension \
--modules-not-available-for-extension=$modules_not_available_for_extension \
$host"
Run::profiles $tree $host $active_cluster
destroy .add
}
}
proc Edit::profiles {tree host values} {
return
}
proc Edit::directory {tree host values} {
global default active_cluster profile_name \
agent_user agent_pwd cluster_user cluster_pwd auth
set lst [GetWorkTreeRow]
set frm [Add::directory $tree $host $profile_name]
$frm configure -text "Редактирование виртуального каталога"
FormFieldsDataInsert $frm [list $lst]
$frm.ent_alias configure -state disable
}
proc Edit::addin {tree host values} {
Edit::acl $tree $host addin "Редактирование внешней компоненты"
}
proc Edit::module {tree host values} {
Edit::acl $tree $host module "Редактирование"
}
proc Edit::com {tree host values} {
Edit::acl $tree $host com "Редактирование COM-класса"
}
proc Edit::app {tree host values} {
Edit::acl $tree $host app "Редактирование приложения"
}
proc Edit::inet {tree host values} {
Edit::acl $tree $host inet "Редактирование ссылки"
}
proc Edit::acl {tree host item descr} {
global default active_cluster profile_name \
agent_user agent_pwd cluster_user cluster_pwd auth
set lst [GetWorkTreeRow]
set frm [Add::$item $tree $host $profile_name]
$frm configure -text $descr
FormFieldsDataInsert $frm [list $lst]
$frm.ent_name configure -state disable
}
proc Del {} {
global active_cluster host
set tree .frm_tree.tree
set id [.frm_tree.tree selection]
set values [.frm_tree.tree item $id -values]
set key [lindex [split $id "::"] 0]
if {$values eq "" || $key eq ""} {return}
Del::$key $tree $host $values
}
namespace eval Del {} {}
proc Del::manager {tree host values} {
return
}
proc Del::managers {tree host values} {
return
}
proc Del::locks {tree host values} {
return
}
proc Del::processes {tree host values} {
return
}
proc Del::admin {tree host values} {
global active_cluster agent_user agent_pwd cluster_user cluster_pwd auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
if {$agent_user ne "" && $agent_pwd ne ""} {
set agent_auth "--agent-user=$agent_user --agent-pwd=$agent_pwd"
} else {
set agent_auth ""
}
set answer [tk_messageBox -message "Удалить администратора $values?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand "cluster admin remove --name=$values --cluster=$active_cluster $auth $host"]
#.frm_tree.tree delete "admin::$values"
set cluster_user ""
set cluster_pwd ""
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
}
no {return}
}
}
proc Del::admins {tree host values} {
Del::admin $tree $host [GetWorkTreeItems "name"]
}
proc Del::agent_admin {tree host values} {
global agent_user agent_pwd auth
if {$agent_user ne "" && $agent_pwd ne ""} {
set agent_auth "--agent-user=$agent_user --agent-pwd=$agent_pwd"
} else {
set agent_auth ""
}
set answer [tk_messageBox -message "Удалить администратора $values?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand "agent admin remove --name=$values $agent_auth $host"]
#.frm_tree.tree delete "admin::$values"
set agent_user ""
set agent_pwd ""
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
}
no {return}
}
}
proc Del::agent_admins {tree host values} {
Del::agent_admin $tree $host [GetWorkTreeItems "name"]
}
proc Del::work_server {tree host values} {
global active_cluster agent_user agent_pwd cluster_user cluster_pwd auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set answer [tk_messageBox -message "Удалить рабочий сервер $values?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand "server remove --cluster=$active_cluster $auth --server=$values $host"]
.frm_tree.tree delete "work_server::$values"
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
}
no {return}
}
}
proc Del::servers {tree host values} {
Del::work_server $tree $host [GetWorkTreeItems "server"]
}
proc Del::cluster {tree host values} {
global agent_user agent_pwd cluster_user cluster_pwd auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set answer [tk_messageBox -message "Удалить кластер $values?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand "cluster remove --cluster=$values $auth $host"]
$tree delete "cluster::$values"
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
}
no {return}
}
}
proc Del::infobase {tree host values} {
global active_cluster agent_user agent_pwd cluster_user cluster_pwd auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set answer [tk_messageBox -message "Удалить информационную базу $values?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand "infobase drop --infobase=$values --cluster=$active_cluster $auth $host"]
$tree delete "infobase::$values"
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
}
no {return}
}
}
proc Del::infobases {tree host values} {
Del::infobase $tree $host [GetWorkTreeItems "infobase"]
}
proc Del::connections {tree host values} {
global active_cluster agent_user agent_pwd cluster_user cluster_pwd auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set connection_id [GetWorkTreeItems "connection"]
set process_id [GetWorkTreeItems "process"]
set answer [tk_messageBox -message "Удалить соединение $connection_id?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand "connection disconnect --process=$process_id --connection=$connection_id --cluster=$active_cluster $auth $host"]
#$tree delete "infobase::$values"
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
}
no {return}
}
}
proc Del::sessions {tree host values} {
global active_cluster agent_user agent_pwd cluster_user cluster_pwd auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set session_id [GetWorkTreeItems "session"]
set answer [tk_messageBox -message "Прервать сессию $session_id?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand "session terminate --session=$session_id --cluster=$active_cluster $auth $host"]
#$tree delete "infobase::$values"
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
}
no {return}
}
}
proc Del::rule {tree host values} {
global active_cluster server agent_user agent_pwd cluster_user cluster_pwd auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
set rule_id [GetWorkTreeItems "rule"]
if {[info exists rule_id] == 0 || $rule_id eq ""} {
return
}
set answer [tk_messageBox -message "Удалить требование $rule_id?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand "rule remove --server=$server --rule=$rule_id --cluster=$active_cluster $auth $host"]
#$tree delete "infobase::$values"
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
}
no {return}
}
}
proc Del::server {tree host values} {
global dir
set answer [tk_messageBox -message "Удалить сервер $values?" \
-icon question -type yesno ]
switch -- $answer {
yes {
file copy [file join $dir(work) 1c_srv.cfg] [file join $dir(work) 1c_srv.cfg.bak]
set orig_file [open [file join $dir(work) 1c_srv.cfg.bak] "r"]
set file [open [file join $dir(work) 1c_srv.cfg] "w"]
while {[gets $orig_file line] >=0 } {
if { $line ne "" && $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 Del::profile {tree host values} {
global active_cluster agent_user agent_pwd cluster_user cluster_pwd auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
if {$agent_user ne "" && $agent_pwd ne ""} {
set agent_auth "--agent-user=$agent_user --agent-pwd=$agent_pwd"
} else {
set agent_auth ""
}
set answer [tk_messageBox -message "Удалить профиль безопасности $values?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand "profile remove --name=$values --cluster=$active_cluster $auth $host"]
.frm_tree.tree delete "profile::$values"
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
Run::profiles $tree $host $active_cluster
}
no {return}
}
}
proc Del::profiles {tree host values} {
Del::profile $tree $host [GetWorkTreeItems "name"]
}
proc Del::acl {host type name profile_name} {
global active_cluster agent_user agent_pwd cluster_user cluster_pwd auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
if {$agent_user ne "" && $agent_pwd ne ""} {
set agent_auth "--agent-user=$agent_user --agent-pwd=$agent_pwd"
} else {
set agent_auth ""
}
if {$type eq "directory"} {
set item "\"--alias=$name\""
} else {
set item "\"--name=$name\""
}
set item [regsub -all -- " " $item "\\ "]
set answer [tk_messageBox -message "Удалить $type - $name?" \
-icon question -type yesno ]
switch -- $answer {
yes {
set lst [RunCommand "profile --cluster=$active_cluster acl --name=$profile_name $type remove $item $auth $host"]
#.frm_tree.tree delete "profile::$values"
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
Run::$type .frm_tree.tree $host $active_cluster
}
no {return}
}
}
proc Del::directory {tree host profile_name} {
Del::acl $host directory [GetWorkTreeItems "alias"] $profile_name
}
proc Del::com {tree host profile_name} {
Del::acl $host com [GetWorkTreeItems "name"] $profile_name
}
proc Del::addin {tree host profile_name} {
Del::acl $host addin [GetWorkTreeItems "name"] $profile_name
}
proc Del::module {tree host profile_name} {
Del::acl $host module [GetWorkTreeItems "name"] $profile_name
}
proc Del::app {tree host profile_name} {
Del::acl $host app [GetWorkTreeItems "name"] $profile_name
}
proc Del::inet {tree host profile_name} {
Del::acl $host inet [GetWorkTreeItems "name"] $profile_name
}