Добавление/Удаление правил, добавление кластера со всеми опциями

lib/function.tcl

@@ -23,7 +23,7 @@ proc TreePress {tree} {
     } elseif {$key eq "work_server"} {
         set server $values
     }
-    #puts "$id $host $values"
+    puts "$id $host $values"
     Run::$key $tree $host $values
     #RunCommand $root "infobase summary list --cluster=$cluster $host"
 }
@@ -367,21 +367,9 @@ proc DebugInfo {widget f} {
 proc Del {} {
     global active_cluster host
     set tree .frm_tree.tree
-    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 $key } {
-            set values [lindex $work_tree_values $i]
-            set tree .frm_work.tree_work
-        }
-        incr i
-    }
     
     Del::$key $tree $host $values
 }
@@ -394,12 +382,33 @@ proc Del::work_server {tree host values} {
     switch -- $answer {
         yes {
             set lst [RunCommand infobase::$values "server remove --cluster=$active_cluster --server=$values $host"]
-            $tree delete "work_server::$values"
+            .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 ]
@@ -425,18 +434,122 @@ proc Del::infobase {tree host values} {
         no {return}
     }
 }
-proc Del::rule {tree host values} {
+proc Del::infobases {tree host values} {
-    global active_cluster server
+    global active_cluster
-    set answer [tk_messageBox -message "Удалить требование $values?" \
+    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 "rule remove --server=$server --rule=$values --cluster=$active_cluster $host"]
+            set lst [RunCommand infobase::$values "connection disconnect --process=$process_id --connection=$connection_id --cluster=$active_cluster $host"]
-            Run::rule $tree $host $server
+            #$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?" \
@@ -724,6 +837,28 @@ proc Add::cluster {tree host values} {
     $frm.ent_port  insert end $default(port)
     label $frm.lbl_cluster_name -text "Название кластера"
     entry  $frm.ent_cluster_name
+    label $frm.lbl_secure_connect -text "Защищённое соединение"
+    set combo_secure_level [ttk::combobox $frm.cb_secure_connect\
+    -textvariable secure_level -values $default(secure_level)]
+    label $frm.lbl_process_off_time -text "Останавливать выключенные процессы через:"
+    entry  $frm.ent_process_off_time
+    label $frm.lbl_level -text "Уровень отказоустойчивости"
+    entry  $frm.ent_level
+    label $frm.lbl_load_balancing -text "Режим распределения нагрузки"
+    set combo_load_balancing [ttk::combobox $frm.cb_load_balancing\
+    -textvariable load_balancing -values $default(load_balancing)]
+    label $frm.lbl_processes -text "Рабочие процессы:"
+    label $frm.lbl_interval -text "Интервал перезапуска, сек."
+    entry  $frm.ent_interval
+    label $frm.lbl_memory -text "Допустимый объём памяти, КБ"
+    entry  $frm.ent_memory
+    label $frm.lbl_memory_interval -text "Интервал превышения допустимого объёма памяти, сек."
+    entry  $frm.ent_memory_interval
+    label $frm.lbl_errors -text "Допустимое отклонение количества ошибок сервера, %"
+    entry  $frm.ent_errors
+    label $frm.lbl_process -justify left -anchor nw -text "Принудительно завершать проблемные процессы"
+    checkbutton $frm.cb_process -variable license_distribution -onvalue allow -offvalue deny
+    
     
     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
@@ -731,6 +866,23 @@ proc Add::cluster {tree host values} {
     grid $frm.ent_port -row 1 -column 1 -sticky nsew -padx 5 -pady 5
     grid $frm.lbl_cluster_name -row 2 -column 0 -sticky nw -padx 5 -pady 5
     grid $frm.ent_cluster_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_secure_connect -row 3 -column 1 -sticky nsew -padx 5 -pady 5
+    grid $frm.lbl_process_off_time -row 4 -column 0 -sticky nw -padx 5 -pady 5
+    grid $frm.ent_process_off_time -row 4 -column 1 -sticky nsew -padx 5 -pady 5
+    grid $frm.lbl_level -row 5 -column 0 -sticky nw -padx 5 -pady 5
+    grid $frm.ent_level -row 5 -column 1 -sticky nsew -padx 5 -pady 5
+    grid $frm.lbl_load_balancing -row 6 -column 0 -sticky nw -padx 5 -pady 5
+    grid $frm.cb_load_balancing -row 6 -column 1 -sticky nsew -padx 5 -pady 5
+    grid $frm.lbl_processes -row 7 -column 0 -sticky nw -padx 5 -pady 5
+    grid $frm.lbl_interval -row 8 -column 0 -sticky nw -padx 5 -pady 5
+    grid $frm.ent_interval -row 8 -column 1 -sticky nsew -padx 5 -pady 5
+    grid $frm.lbl_memory -row 9 -column 0 -sticky nw -padx 5 -pady 5
+    grid $frm.ent_memory -row 9 -column 1 -sticky nsew -padx 5 -pady 5
+    grid $frm.lbl_memory_interval -row 10 -column 0 -sticky nw -padx 5 -pady 5
+    grid $frm.ent_memory_interval -row 10 -column 1 -sticky nsew -padx 5 -pady 5
+    grid $frm.lbl_process -row 11 -column 0 -sticky nw -padx 5 -pady 5
+    grid $frm.cb_process -row 11 -column 1 -sticky nsew -padx 5 -pady 5
     
     .add.frm_btn.btn_ok configure -command {
         RunCommand "" "cluster insert \
@@ -820,3 +972,5 @@ proc SaveMainServer {host port} {
     return "$host:$port"
 }
 
+
+

rac_gui.cfg

@@ -74,11 +74,27 @@ set default(type) {
     always
     never
 }
-
 # Приоритет
 set default(priority) 0
+# Интервал перезапуска рабочих процессов
+set default(interval) 0
+# максимальный объем виртуального адресного пространства (в килобайтах),
+# занятого рабочим процессом
+set default(memory) 0
+# Интервал превышения допустимого объема памяти (сек.)
+set default(memory_interval) 0
+# Допустимое отклонение количества ошибок сервера (%)
+set default(errors_threshold) 0
+# режим распределения нагрузки
+#    performance - приоритет по производительности
+#    memory - приоритет по памяти
+set default(load_balancing) {
+    performance
+    memory
+}
 
 # цвета строк в таблице
 set color(dark_table_bg) "#e2e2e2"
 set color(light_table_bg) "#ffffff"
 
+