Пишем GUI за 1С RAC, или отново за Tcl/Tk

С течение на запознаването с темата за работата на продуктите на 1С в средата на Linux, беше открит един недостатък — липсата на удобен графичен многоплатформен инструмент за управление на клъстера от сървъри 1С. Затова беше решено да се ремонтира този недостатък чрез написване на GUI за консолната утилита rac. За разработка беше избран tcl/tk, тъй като е най-подходящ за тази задача. Искам да представя някои интересни аспекти на решението в този материал.

За работа ще са необходими дистрибуции на tcl/tk и 1С. Тъй като реших максимално да използвам възможностите на базовата версия на tcl/tk без прилагане на външни пакети, ще е необходима версия 8.6.7, която включва ttk — пакет с допълнителни графични елементи, от които основно ще ни трябва ttk::TreeView, позволяващ извеждане на данни и под формата на дървовидна структура, и под формата на таблица (списък). Освен това в новата версия е преработено работата с изключенията (командата try, която в проекта се използва при стартиране на външни команди).

Проектът се състои от няколко файла (въпреки че нищо не пречи всичко да се направи в един):

rac_gui.cfg — дефолтната конфигурация
rac_gui.tcl — основният скрипт за стартиране
В каталога lib се намират файловете, които автоматично се зареждат при стартиране:
function.tcl — файл с процедури
gui.tcl — основният графичен интерфейс
images.tcl — библиотека от изображения в base64

Файлът rac_gui.tcl всъщност стартира интерпретатора, инициализира променливите, зарежда модулите, конфигурациите и т.н. Съдържанието на файла с коментари:

rac_gui.tcl

#!/bin/sh
exec wish "$0" -- "$@"

# Устанавливаем текущий каталог
set dir(root) [pwd]
# Устанавливаем рабочий каталог, если его нет то создаём
set dir(work) [file join $env(HOME) .rac_gui]
if {[file exists $dir(work)] == 0 } {
    file mkdir $dir(work)    
}
# каталог с модулями
set dir(lib) "[file join $dir(root) lib]"

# загружаем пользовательский конфиг, если он отсутствует, то копируем дефолтный
if {[file exists [file join $dir(work) rac_gui.cfg]] ==0} {
    file copy [file join [pwd] rac_gui.cfg] [file join $dir(work) rac_gui.cfg]
} 
source [file join $dir(work) rac_gui.cfg]
# Код проверки наличия rac и правильности указания пути в конфиге
# если программа не найдена то будет выведен диалог для указания корректного пути
# и этот путь будет записан в пользовательский конфиг
if {[file exists $rac_cmd] == 0} {
    set rac_cmd [tk_getOpenFile -initialdir $env(HOME) -parent . -title "Укажите путь до rac" -initialfile rac]
    file copy [file join $dir(work) rac_gui.cfg] [file join $dir(work) rac_gui.cfg.bak] 
    set orig_file [open [file join $dir(work) rac_gui.cfg.bak] "r"]
    set file [open [file join $dir(work) rac_gui.cfg] "w"]
    while {[gets $orig_file line] >=0 } {
        if {[string match "set rac_cmd*" $line]} {
            puts $file "set rac_cmd $rac_cmd"
        } else {
            puts $file $line
        }
    }
    close $file
    close $orig_file
    #return "$host:$port"
    file delete [file join $dir(work) 1c_srv.cfg.bak] 
} else {
    puts "Found $rac_cmd"
}

set cluster_user ""
set cluster_pwd ""
set agent_user ""
set agent_pwd ""
## LOAD FILE ##
# Загружаем модули кроме gui.tcl так как его надо загрузить последним
foreach modFile [lsort [glob -nocomplain [file join $dir(lib) *.tcl]]] {
    if {[file tail $modFile] ne "gui.tcl"} {
        source $modFile
        puts "Loaded module $modFile"
    }
}
source [file join $dir(lib) gui.tcl]
source [file join $dir(work) rac_gui.cfg]

# Читаем файл со списком серверов 1С
# и добавляем в дерево
if [file exists [file join $dir(work) 1c_srv.cfg]] {
    set f [open [file join $dir(work) 1c_srv.cfg] "RDONLY"]
    while {[gets $f line] >=0} {
        .frm_tree.tree insert {} end -id "server::$line" -text "$line" -values "$line"
    }    
}

След зареждане на всичко необходимо и проверка на наличието на утилита rac, ще бъде стартирано графичното прозорец. Интерфейсът на програмата се състои от три елемента:

Лента с инструменти, дърво и списък

Съдържанието на "дървото" направих максимално подобно на стандартния Windows компонент на 1С.

Пишем GUI за 1С RAC, или отново за Tcl/Tk

Основният код, формиращ това прозорец, се съдържа в файла
lib/gui.tcl

# установка размера и положения основного окна
# можно установить в переменную topLevelGeometry в конфиг программы
if {[info exists topLevelGeometry]} {
    wm geometry . $topLevelGeometry
} else {
    wm geometry . 1024x768
}
# Заголовок окна
wm title . "1C Rac GUI"
wm iconname . "1C Rac Gui"
# иконка окна (берется из файла lib/imges.tcl)
wm iconphoto . tcl
wm protocol . WM_DELETE_WINDOW Quit
wm overrideredirect . 0
wm positionfrom . user

ttk::style theme use clam

# Панель инсрументов
set frm_tool [frame .frm_tool]
pack $frm_tool -side left -fill y 
ttk::panedwindow .panel -orient horizontal -style TPanedwindow
pack .panel -expand true -fill both
pack propagate .panel false

ttk::button $frm_tool.btn_add  -command Add  -image add_grey_32
ttk::button $frm_tool.btn_del  -command Del -image del_grey_32
ttk::button $frm_tool.btn_edit  -command Edit -image edit_grey_32
ttk::button $frm_tool.btn_quit -command Quit -image quit_grey_32

pack $frm_tool.btn_add $frm_tool.btn_del $frm_tool.btn_edit -side top -padx 5 -pady 5
pack $frm_tool.btn_quit  -side bottom -padx 5 -pady 5

# Дерево с полосами прокрутки
set frm_tree [frame .frm_tree]

ttk::scrollbar $frm_tree.hsb1 -orient horizontal -command [list $frm_tree.tree xview]
ttk::scrollbar $frm_tree.vsb1 -orient vertical -command [list $frm_tree.tree yview]
set tree [ttk::treeview $frm_tree.tree -show tree 
-xscrollcommand [list $frm_tree.hsb1 set] -yscrollcommand [list $frm_tree.vsb1 set]]

grid $tree -row 0 -column 0 -sticky nsew
grid $frm_tree.vsb1 -row 0 -column 1 -sticky nsew
grid $frm_tree.hsb1 -row 1 -column 0 -sticky nsew
grid columnconfigure $frm_tree 0 -weight 1
grid rowconfigure $frm_tree 0 -weight 1

# назначение обработчика нажатия кнопкой мыши
bind $frm_tree.tree <ButtonRelease> "TreePress $frm_tree.tree"

# Список для данных (таблица)
set frm_work [frame .frm_work]
ttk::scrollbar $frm_work.hsb -orient horizontal -command [list $frm_work.tree_work xview]
ttk::scrollbar $frm_work.vsb -orient vertical -command [list $frm_work.tree_work yview]
set tree_work [
    ttk::treeview $frm_work.tree_work 
    -show headings  -columns "par val" -displaycolumns "par val"
    -xscrollcommand [list $frm_work.hsb set] 
    -yscrollcommand [list $frm_work.vsb set]
]
# Установка цветов для чередования в таблице
$tree_work tag configure dark -background $color(dark_table_bg)
$tree_work tag configure light -background $color(light_table_bg)

# Размещение элементов на форме
grid $tree_work -row 0 -column 0 -sticky nsew
grid $frm_work.vsb -row 0 -column 1 -sticky nsew
grid $frm_work.hsb -row 1 -column 0 -sticky nsew
grid columnconfigure $frm_work 0 -weight 1
grid rowconfigure $frm_work 0 -weight 1
pack $frm_tree $frm_work -side left -expand true -fill both

#.panel add $frm_tool -weight 1
.panel add $frm_tree -weight 1 
.panel add $frm_work -weight 1

Алгоритъмът на работа с програмата е следният:

1. Първо, трябва да добавите основния сървър на клъстера (т.е. сървър за управление на клъстера (в Linux управлението стартира с командата " /opt/1C/v8.3/x86_64/ras cluster —daemon ")).

За целта натискаме бутона „+“ и в отворилото се прозорче, въвеждаме адреса на сървъра и порта:

Пишем GUI за 1С RAC, или отново за Tcl/Tk

След това, в дървото ще се появи нашият сървър, при щракване на който ще се отвори списъкът на клъстерите или ще бъде изведена грешка при свързването.

2. Като кликнете върху името на клъстера, ще се отвори списък с налични функции за него.

3.…

И така нататък, т.е. за да добавите нов клъстер, изберете който и да е наличен от списъка и натиснете бутон „+“ в инструменталната лента, след което ще се появи диалог за добавяне на нов.

Пишем GUI за 1С RAC, или отново за Tcl/Tk

Бутонистите в инструменталната лента изпълняват функции в зависимост от контекста, т.е. от това кой елемент от дървото или списъка е избран, ще бъде изпълнена съответната процедура.

Нека видим на примера на бутона за добавяне („+“):

Код за създаване на бутона:

ttk::button $frm_tool.btn_add  -command Add  -image add_grey_32

Тук виждаме, че при натискане на бутона ще се изпълни процедурата „Add“, нейният код:

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
    }
    Add::$key .frm_tree.tree $host $values
}

Така стигаме до едно от предимствата на тикля — може да предадете стойността на променлива като име на процедура:

Add::$key .frm_tree.tree $host $values

Т.е. например, ако кликнем на основния сървър и натиснем „+“, ще бъде стартирана процедурата Add::server; ако кликнем на клъстера — Add::cluster и така нататък (по-късно ще обясня откъде идват необходимите „ключове“); изброените процедури рисуват графични елементи, отговарящи на контекста.

Както вече сте могли да забележите, формите изглеждат по подобен стил — което не е изненадващо, тъй като те се извеждат от една процедура, точната основна рамка на формата (прозорец, бутони, изображение, етикет), името на процедурата. AddTopLevel

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
}

Параметри на повик: заглавие, име на изображението за иконата от библиотеката (lib/images.tcl) и опционален параметър за име на прозореца (по подразбиране .add). Така, ако вземем горепосочените примери за добавяне на основен сървър и клъстер, повикването ще бъде съответно:

AddToplevel "Добавяне на основен сървър" server_grey_64

или

AddToplevel "Добавяне на клъстер" cluster_grey_64

И продължавайки с тези примери, ще покажа процедурите, които извеждат диалози за добавяне на сървър или клъстер.

Add::server

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
}

Add::cluster

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 "Име на клaster"
    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
}

При сравняване на кода на тези процедури, разликата е видима с просто око, но ще се фокусирам върху обработчика на бутона „Ок“. В Tk свойствата на графичните елементи могат да се пренастройват по време на изпълнението на програмата чрез опция. конфигурирайте. Например, първоначалната команда за извеждане на бутона:

ttk::button $frm_btn.btn_ok -image ok_grey_24 -command { }

Но в нашите форми командата зависи от нужната функционалност:

  .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
    }

В горния пример, на бутона „забит“ се стартира процедура за добавяне на клъстер.

Тук е уместно да направим извлечение за работата с графичните елементи в Tk – за различните елементи за въвеждане на данни (entry, combobox, checkbutton и др.) е въведен такъв параметър като текстова променлива (textvariable):

entry  $frm.ent_lifetime_limit -textvariable lifetime_limit

Тази променлива е определена в глобалното пространство и съдържа текущо въведената стойност. Тоест, за да получите въведения текст от полето, просто трябва да прочетете стойността на съответната променлива (разбира се, при условие, че тя е определена при създаването на елемента).

Вторият метод за получаване на въведения текст (за елементи от тип entry) е използването на командата get:

.add.frm.ent_name get

И двата метода могат да се видят в горния код.

Натискането на този бутон, в този случай, стартира процедурата RunCommand с формираната команда за добавяне на клъстера в термина rac:

/opt/1C/v8.3/x86_64/rac cluster insert  --host=localhost  --port=1540  --name=dsdsds  --expiration-timeout=0  --lifetime-limit=0  --max-memory-size=0  --max-memory-time-limit=0  --security-level=0  --session-fault-tolerance-level=0  --load-balancing-mode=performance  --errors-count-threshold=0  --kill-problem-processes=no   localhost:1545

Стигнахме до основната команда, която управлява стартирането на rac с нужните ни параметри, както и анализира изхода на командите в списъци и връща, ако е нужно:

RunCommand

proc RunCommand {root par} {
    global dir rac_cmd cluster work_list_row_count agent_user agent_pwd cluster_user cluster_pwd
    puts "$rac_cmd $par"
    set work_list_row_count 0
    # Отваряме канал в неблокиращ режим
    # $rac - команда с пълния път
    # $par - генерираните ключове за стартиране и опции    
    set pipe [open "|$rac_cmd $par" "r"]
    try {
        set lst ""
        set l ""
        # Добавяме изхода на командата в списъка с листи
        while {[gets $pipe line]>=0} {
            #puts $line
            if {$line eq ""} {
                lappend l $lst
                set lst ""
            } else {
                lappend lst [string trim $line]
            }
        }
        close $pipe
        return $l
    } on error {result options} {
        # Запускаме обработчика за грешки
        ErrorParcing $result $options
        return ""
    }
}

След въвеждането на данните на основния сървър, той ще бъде добавен в дървото, за което отговаря следният код в процедурата Add:server:

.frm_tree.tree insert {} end -id "server::$host" -text "$host" -values "$host"

Сега, щраквайки върху името на сървъра в дървото, ще получим списък с клъстери, управлявани от този сървър, а при щракване на клъстер, ще получим списък с елементите на клъстера (сървъри, информационни бази и т.н.). Реализирано е в процедурата TreePress (файл lib/function.tcl):

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]
   # и в зависимост от това какво сме избрали, ще бъде стартирана съответната процедура
   # в пространството на имената Run
    Run::$key $tree $host $values
}

Съответно, за основния сървър ще се стартира Run::server (за клъстера — Run::cluster, за работния сървър — Run::work_server и т.н.). Т.е. стойността на променливата $key е част от името на елемента в дървото, зададена с опцията -id.

Обърнете внимание на процедурата

Run::server

proc Run::server {tree host values} {
    # получаваме списък от клъстери за нужния сървър
    set lst [RunCommand server::$host "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
    }
}

Тази процедура обработва данните, получени от сървъра чрез командата RunCommand, и добавя различни елементи в дървото — клъстери, различни коренови елементи (бази, работещи сървъри, сесии и т.н.). Ако се вгледате, ще забележите, че вътре се извиква процедурата InsertItemsWorkList. Тя се използва за добавяне на елементи в графичния списък, обработвайки извода на конзолната утилита rac, който преди това е бил върнат в променливата $lst. Това е списък от списъци, съдържащи двойки елементи, разделени с двоеточие.

Например, списък на връзките на клъстера:

svk@svk ~]$ /opt/1C/v8.3/x86_64/rac connection list --cluster=783d2170-56c3-11e8-c586-fc75165efbb2 localhost:1545
connection     : dcf5991c-7d24-11e8-1690-fc75165efbb2
conn-id        : 0
host           : svk.home
process        : 79de2e16-56c3-11e8-c586-fc75165efbb2
infobase       : 00000000-0000-0000-0000-000000000000
application    : "JobScheduler"
connected-at   : 2018-07-01T14:49:51
session-number : 0
blocked-by-ls  : 0

connection     : b993293a-7d24-11e8-1690-fc75165efbb2
conn-id        : 0
host           : svk.home
process        : 79de2e16-56c3-11e8-c586-fc75165efbb2
infobase       : 00000000-0000-0000-0000-000000000000
application    : "JobScheduler"
connected-at   : 2018-07-01T14:48:52
session-number : 0
blocked-by-ls  : 0

Графично това ще изглежда приблизително така:

Пишем GUI за 1С RAC, или отново за Tcl/Tk

По-горе споменатата процедура извлече имената на елементите за заглавието и данните за попълване на таблицата:

InsertItemsWorkList

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
}

Тук вместо простата команда [split $str «:»], която разделя низ на елементи, разделени с «:» и връща списък, е приложено регулярното изразяване, тъй като някои елементи също съдържат двоеточие.

Процедурата InsertClusterItems (една от няколко подобни) просто добавя към дървото към необходимия елемент cluster списък от дъщерни елементи с подходящите идентификатори
InsertClusterItems

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
}

Може да се разгледат още два варианта за реализиране на подобна процедура, където ясно ще се види как да се оптимизира и да се избегнат повтарящи се команди:

В тази процедура добавянето и проверките са решени в прав текст:

InsertBaseItems

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"
    }
}

А тук подходът е по-правилен:

InsertProfileItems

proc InsertProfileItems {tree id} {
    set parent "profile::$id"
    set lst {
        {dir "Виртуални каталози"}
        {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 
    }
}

Разликата между тях е в прилагането на цикъла, в който се изпълнява повторящата се команда (команди). Какъв подход да се прилага — това вече е на преценка на разработчика.

Добавянето на елементи и получаването на данни разгледахме, време е да спрем на редактирането. Тъй като основно за редактиране и добавяне се използват едни и същи параметри (с изключение на информационната база), диалоговите форми също са едни и същи. Алгоритъмът за извикване на процедурите за добавяне изглежда така:

Add::$key->AddToplevel

А за редактиране по следния начин:

Edit::$key->Add::$key->AddTopLevel

За пример ще вземем редактирането на клъстера, т.е. щраквайки върху името на клъстера в дървото, натискаме бутона за редактиране в панела с инструменти (молив) и на екрана ще се появи съответната форма:

Пишем GUI за 1С RAC, или отново за Tcl/Tk
Edit::cluster

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::$values "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
    }
}

Според коментарите в кода, по принцип всичко е ясно, освен че обработчикът на бутона е преназначен и има процедура FormFieldsDataInsert, която попълва полетата с данни и инициализира променливите:

FormFieldsDataInsert

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
                }
            }
        }
    }
}

В тази процедура изникна още едно предимство на tcl — като имена на променливи се подставят стойностите на други променливи. Т.е. за автоматизация на попълване на формуляри и инициализация на променливи названията на полетата и променливите съответстват на ключовете от командния ред на утилитата rac и названията на параметрите на командите с известни изключения — тирето е заменено с подчертание. Например scheduled-jobs-deny съответства на полето ent_scheduled_jobs_deny и променливата scheduled_jobs_deny.

Формите за добавяне и редактиране могат да се различават по състав от полета, например, работа с информационна база:

Добавяне на ИБ

Пишем GUI за 1С RAC, или отново за Tcl/Tk

Редактиране на ИБ

Пишем GUI за 1С RAC, или отново за Tcl/Tk

В процедурата за редактиране Edit::infobase на формата се добавят необходимите полета, кодът е обемен, затова тук не го представям.

По аналогия са реализирани процедурите за добавяне, редактиране, изтриване и за останалите елементи.

Тъй като работата на утилитата предвижда неограничен брой сървъри, клъстери, информационни бази и т.н., за определяне на кой клъстер принадлежи кой сървър или ИБ, са въведени няколко глобални променливи, стойностите на които се задават при всяко кликване по елементите на дървото. Т.е. процедурата рекурсивно преминава през всички родителски елементи и задава променливите:

SetGlobalVarFromTreeItems

proc SetGlobalVarFromTreeItems {tree id} {
    global host server active_cluster infobase
    set parent [$tree parent $id]
    set values [$tree item $id -values]
    set key [lindex [split $id "::"] 0]
    switch -- $key {
        server {set host $values}
        work_server {set server $values}
        cluster {set active_cluster $values}
        infobase {set infobase $values}
    }
    if {$parent eq ""} {
        return
    } else {
        SetGlobalVarFromTreeItems $tree $parent
    }
}

Клъстерът 1С позволява работа както с автентикация, така и без. Съществуват два вида администратори — администратори на агента на клъстера и администратори на клъстера. Съответно за коректна работа са въведени още 4 глобални променливи, съдържащи логин и парола на администратора. Т.е. ако в клъстера присъства учетна запис на администратора, ще бъде изведен диалог за въвеждане на логин и парола, данните ще бъдат запазени в паметта и ще се подставят във всяка команда за съответния клъстер.

За това отговаря процедурата за обработка на грешки

ErrorParcing

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"
        }
    }
}

Т.е. в зависимост от това, какво връща командата, ще е и реакцията.

В момента функционалността е реализирана на около 95%, остава да се изпълни работата с профилите за защита и да се тества =). С това приключвам. Извинявайте за сбитото изложение.

Кодът, по традиция, е наличен. тук.

Актуализация: Завърших работата с профилите за защита. Сега функционалността е реализирана на 100%.

Актуализация 2: Добавена е локализация на английски и руски, проверена е работата в win7.
Пишем GUI за 1С RAC, или отново за Tcl/Tk

Източник: habr.com

Купете надежден хостинг за сайтове със защита от DDoS, VPS и VDS сървъри 🔥 Купете надежден хостинг за сайтове със защита от DDoS, VPS и VDS сървъри | ProHoster