Jakmile jsem se ponořil do problematiky produktů 1C v prostředí Linux, objevil jsem jednu nevýhodu — chybějící pohodlný grafický multiplatformní nástroj pro správu clusteru serverů 1C. Bylo rozhodnuto tuto nevýhodu odstranit napsáním GUI pro konzolovou utilitu rac. Jako programovací jazyk byl zvolen tcl/tk, který mi připadal nejvhodnější pro tento úkol. A nyní bych rád představil některé zajímavé aspekty řešení v tomto materiálu.
K práci budou potřeba distribuce tcl/tk a 1C. A protože jsem se rozhodl maximálně využít možnosti základní distribuce tcl/tk bez použití externích balíčků, bude potřeba verze 8.6.7, která obsahuje ttk — balíček s dodatečnými grafickými prvky, z nichž budeme potřebovat především ttk::TreeView, který umožňuje zobrazovat data jak ve formě stromové struktury, tak v podobě tabulky (seznamu). Dále, v nové verzi byla přepracována práce s výjimkami (příkaz try, který se v projektu používá při spouštění externích příkazů).
Projekt se skládá z několika souborů (i když nic nebrání dělat vše v jednom):
rac_gui.cfg — defaultní konfigurace
rac_gui.tcl — hlavní spouštěcí skript
V adresáři lib leží soubory automaticky načítané při startu:
function.tcl — soubor s procedurami
gui.tcl — hlavní grafické rozhraní
images.tcl — knihovna obrázků v base64
Soubor rac_gui.tcl vlastně spouští interpreter, inicializuje proměnné, načítá moduly, konfigurace a další. Obsah souboru s komentáři:
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"
}
}Po načtení všeho potřebného a kontrole existence utility rac se otevře grafické okno. Rozhraní programu se skládá ze tří prvků:
Panel nástrojů, strom a seznam
Obsah „stromu“ jsem udělal co nejvíce podobný standardní windowsové komponentě od 1C.
Hlavní kód vytvářející toto okno se nachází v souboru
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
Algoritmus práce s programem je následující:
1. Na začátku je třeba přidat hlavní server clusteru (tj. server pro řízení clusteru (v linuxu se spuštění řídí příkazem „/opt/1C/v8.3/x86_64/ras cluster —daemon“)).
K tomu klikněte na tlačítko „+“ a v otevřeném okně zadejte adresu serveru a port:
Poté se v stromu objeví náš server, na který když kliknete, otevře se seznam clusterů nebo se zobrazí chyba připojení.
2. Kliknutím na název clusteru se otevře seznam funkcí, které jsou mu dostupné.
3.…
A tak dále, tj. pro přidání nového clusteru vybereme jakýkoliv dostupný v seznamu a klikneme na tlačítko „+“ na panelu nástrojů, čímž se otevře dialog pro přidání nového:
Tlačítka na panelu nástrojů vykonávají funkce v závislosti na kontextu, tj. podle toho, který prvek stromu nebo seznamu je vybrán, bude provedena odpovídající procedura.
Na příkladu tlačítka pro přidání („+“) si to objasníme:
Kód pro vytvoření tlačítka:
ttk::button $frm_tool.btn_add -command Add -image add_grey_32Vidíme, že po stisknutí tlačítka se provede procedura „Add“, jejíž kód je:
proc Add {} {
global active_cluster host
# Určíme identifikátor vybraného prvku
set id [.frm_tree.tree selection]
# Určíme hodnotu tohoto prvku
set values [.frm_tree.tree item [.frm_tree.tree selection] -values]
set key [lindex [split $id "::"] 0]
# v závislosti na tom, co jsme vybrali, se spustí příslušná procedura
if {$key eq "" || $key eq "server"} {
set host [Add::server]
return
}
Add::$key .frm_tree.tree $host $values
}To je jeden z přínosů tiklu – jako název procedury můžeme předat hodnotu proměnné:
Add::$key .frm_tree.tree $host $valuesTj. například, pokud klikneme na hlavní server a stiskneme „+“, spustí se procedura Add::server; pokud na cluster – Add::cluster a tak dále (o tom, odkud se berou potřebné „klíče“, napíšu později), uvedené procedury vykreslují grafické prvky odpovídající kontextu.
Jak jste si již mohli všimnout, formuláře mají podobný styl – a to není překvapivé, protože jsou vykreslovány jednou procedurou, konkrétně hlavním rámcem formuláře (okno, tlačítka, obrázek, štítek), název procedury 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
# štítek s ikonou
ttk::label $win_name.lbl -image $img
# rámec s poli pro vstup
set frm [ttk::labelframe $win_name.frm -text $lbl -labelanchor nw]
grid columnconfigure $frm 0 -weight 1
grid rowconfigure $frm 0 -weight 1
# rámec a tlačítka
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
}
Parametry volání: nadpis, název obrázku pro ikonu z knihovny (lib/images.tcl) a volitelný parametr jméno okna (výchozí .add). Tedy pokud vezmeme výše uvedené příklady pro přidání hlavního serveru a clusteru, volání bude odpovídajícím způsobem:
AddToplevel "Přidání hlavního serveru" server_grey_64nebo
AddToplevel "Přidání clusteru" cluster_grey_64Pokračujíc s těmito příklady ukážu procedury, které zobrazují dialogy pro přidání serveru nebo clusteru.
Add::server
proc Add::server {} {
global default
# zobrazujeme hlavní formulář
set frm [AddToplevel "Přidání hlavního serveru" server_grey_64]
# přidáváme popisky a vstupní pole do tohoto formuláře
label $frm.lbl_host -text "Adresa serveru"
entry $frm.ent_host
label $frm.lbl_port -text "Port"
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]
# předefinujeme zpracování stisknutí tlačítka
.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 ""
}
# nastavujeme globální proměnné ()
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 "Přidání clusteru" cluster_grey_64]
label $frm.lbl_host -text "Adresa hlavního serveru"
entry $frm.ent_host
label $frm.lbl_port -text "Port"
entry $frm.ent_port
$frm.ent_port insert end $default(port)
label $frm.lbl_name -text "Název clusteru"
entry $frm.ent_name
label $frm.lbl_secure_connect -text "Zabezpečené připojení"
ttk::combobox $frm.cb_security_level -textvariable security_level -values $default(security_level)
label $frm.lbl_expiration_timeout -text "Zastavit vypnuté procesy po:"
entry $frm.ent_expiration_timeout -textvariable expiration_timeout
label $frm.lbl_session_fault_tolerance_level -text "Úroveň odolnosti vůči chybám"
entry $frm.ent_session_fault_tolerance_level -textvariable session_fault_tolerance_level
label $frm.lbl_load_balancing_mode -text "Mód vyvažování zátěže"
ttk::combobox $frm.cb_load_balancing_mode -textvariable load_balancing_mode
-values $default(load_balancing_mode)
label $frm.lbl_errors_count_threshold -text "Přijatelná odchylka počtu chyb serveru, %"
entry $frm.ent_errors_count_threshold -textvariable errors_count_threshold
label $frm.lbl_processes -text "Pracovní procesy:"
label $frm.lbl_lifetime_limit -text "Perioda restartu, sec."
entry $frm.ent_lifetime_limit -textvariable lifetime_limit
label $frm.lbl_max_memory_size -text "Přijatelný objem paměti, KB"
entry $frm.ent_max_memory_size -textvariable max_memory_size
label $frm.lbl_max_memory_time_limit -text "Interval překročení přijatelnou kapacitou paměti, sec."
entry $frm.ent_max_memory_time_limit -textvariable max_memory_time_limit
label $frm.lbl_kill_problem_processes -justify left -anchor nw -text "Násilně ukončit problematické procesy"
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
# předefinujeme obsluhu
.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
}Při porovnání kódu těchto procedur je rozdíl na první pohled jasný. Zaměřím se na zpracovatele tlačítka „Ok“. V Tk lze vlastnosti grafických prvků předefinovat během chodu programu pomocí volby. konfigurovat. Například původní příkaz pro výstup tlačítka:
ttk::button $frm_btn.btn_ok -image ok_grey_24 -command { }Ale v našich formulářích příkaz závisí na požadované funkčnosti:
.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
}
V uvedeném příkladu je na tlačítko „zapnuta“ procedura pro přidání clustera.
Je dobré učinit odbočku směrem k práci s grafickými prvky v Tk – pro různé prvky pro vkládání dat (entry, combobox, checkbutton atd.) byl zaveden takový parametr jako textová proměnná (textvariable):
entry $frm.ent_lifetime_limit -textvariable lifetime_limitProměnná je definována v globálním jmenném prostoru a obsahuje aktuálně vloženou hodnotu. Tedy pro získání vloženého textu z pole je třeba jednoduše načíst hodnotu příslušné proměnné (samozřejmě za předpokladu, že byla definována při vytváření prvku).
Druhý způsob, jak získat vložený text (pro prvky typu entry), je použití příkazu get:
.add.frm.ent_name getOba tyto metody lze vidět v výše uvedeném kódu.
Stisknutí tohoto tlačítka v tomto případě spouští proceduru RunCommand se sestaveným příkazovým řetězcem pro přidání clustera v termínech 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:1545A dostali jsme se k hlavnímu příkazu, který ovládá spuštění rac s požadovanými parametry, také analyzuje výstup příkazů na seznamy a vrací, pokud je to potřeba:
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
# otevření kanálu v nebloocking módu
# $rac - příkaz s plnou cestou
# $par - vytvořené klíče spuštění a možnosti
set pipe [open "|$rac_cmd $par" "r"]
try {
set lst ""
set l ""
# výstup příkazu přidáváme do seznamu seznamů
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} {
# Spouštění zpracovatele chyb
ErrorParcing $result $options
return ""
}
}Po zadání dat hlavního serveru bude přidán do stromu, za to, v výše uvedené proceduře Add:server, odpovídá následující kód:
.frm_tree.tree insert {} end -id "server::$host" -text "$host" -values "$host"Nyní, když klikneme na jméno serveru ve stromě, získáme seznam clusterů spravovaných tímto serverem, a když klikneme na cluster, získáme seznam prvků clusteru (servery, informačních databází atd.). To je realizováno v proceduře TreePress (soubor lib/function.tcl):
proc TreePress {tree} {
global host server active_cluster infobase
# určíme vybraný prvek
set id [$tree selection]
# nastavíme potřebné globální proměnné
SetGlobalVarFromTreeItems $tree $id
# Určíme klíč a hodnotu, t.j. typ vybraného prvku
set values [$tree item $id -values]
set key [lindex [split $id "::"] 0]
# a v závislosti na tom, co jsme vybrali, bude spuštěna odpovídající procedura
# v prostoru jmen Run
Run::$key $tree $host $values
}V souladu s tím se pro hlavní server spustí Run::server (pro cluster — Run::cluster, pro pracovní server — Run::work_server atd.). T.j. hodnota proměnné $key je část názvu prvku stromu, určená volbou -id.
Všimněme si procedury
Run::server
proc Run::server {tree host values} {
# získáme seznam clusterů požadovaného serveru
set lst [RunCommand server::$host "cluster list $host"]
if {$lst eq ""} {return}
set l [lindex $lst 0]
#puts $lst
# odstraníme nadbytečné z seznamu
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
# čteme seznam
foreach cluster_list $lst {
# Vyplňujeme seznam získanými hodnotami
InsertItemsWorkList $cluster_list
# zpracováváme výstup (seznam) pro přidání dat do stromu
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]]
}
}
}
# přidáváme clustery do stromu
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"
# přidáváme prvky do clusteru
InsertClusterItems $tree $id
}
}
if { [$tree exists "agent_admins::$id"] == 0 } {
$tree insert "server::$host" end -id "agent_admins::$id" -text "Administrátoři" -values "$id"
#InsertClusterItems $tree $id
}
}Tato procedura zpracovává, co bylo získáno ze serveru prostřednictvím příkazu RunCommand, a přidává různé prvky do stromu — clustery, různé kořenové prvky (databáze, pracovní servery, sezení atd.). Při bližším pohledu můžete uvnitř spatřit volání procedury InsertItemsWorkList. Ta se používá k přidání prvků do grafického seznamu, zpracovávajíc výstup konzolového nástroje rac, který byl dříve vrácen jako seznam do proměnné $lst. Tento seznam obsahuje páry prvků oddělené dvojtečkou.
Například seznam připojení clusteru:
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
Graficky to bude vypadat přibližně takto:
Vyše uvedená procedura vyčleňuje názvy prvků pro záhlaví a data pro vyplnění tabulky:
InsertItemsWorkList
proc InsertItemsWorkList {lst} {
global work_list_row_count
# nastaví barvu pro řádek
if [expr $work_list_row_count % 2] {
set tag dark
} else {
set tag light
}
# rozdělení řádků na páry klíč - hodnota
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]
}
}
# naplnění tabulky
.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
# nastavení hlaviček
foreach j $column_list {
.frm_work.tree_work heading $j -text $j
}
incr work_list_row_count
}Zde místo jednoduchého příkazu [split $str «:»], který rozděluje řetězec na prvky oddělené «:» a vrací seznam, bylo aplikováno regulární vyjádření, protože některé prvky také obsahují dvojtečku.
Procedura InsertClusterItems (jedna z několika podobných) jednoduše přidává do stromu k požadovanému prvku cluster seznam podřízených prvků s odpovídajícími identifikátory
InsertClusterItems
proc InsertClusterItems {tree id} {
set parent "cluster::$id"
$tree insert $parent end -id "infobases::$id" -text "Infobáze" -values "$id"
$tree insert $parent end -id "servers::$id" -text "Pracovní servery" -values "$id"
$tree insert $parent end -id "admins::$id" -text "Administrátoři" -values "$id"
$tree insert $parent end -id "managers::$id" -text "Manažeři clusteru" -values $id
$tree insert $parent end -id "processes::$id" -text "Pracovní procesy" -values "workprocess-all"
$tree insert $parent end -id "sessions::$id" -text "Sezení" -values "sessions-all"
$tree insert $parent end -id "locks::$id" -text "Zámky" -values "blocks-all"
$tree insert $parent end -id "connections::$id" -text "Spojení" -values "connections-all"
$tree insert $parent end -id "profiles::$id" -text "Bezpečnostní profily" -values $id
}
Můžeme také zvážit další dvě varianty realizace podobné procedury, kde bude zřejmé, jak optimalizovat a zbavit se opakujících se příkazů:
V této proceduře jsou přidání a kontrola řešeny přímo:
InsertBaseItems
proc InsertBaseItems {tree id} {
set parent "infobase::$id"
if { [$tree exists "sessions::$id"] == 0 } {
$tree insert $parent end -id "sessions::$id" -text "Sezení" -values "$id"
}
if { [$tree exists "locks::$id"] == 0 } {
$tree insert $parent end -id "locks::$id" -text "Zámky" -values "$id"
}
if { [$tree exists "connections::$id"] == 0 } {
$tree insert $parent end -id "connections::$id" -text "Spojení" -values "$id"
}
}
A zde je přístup správnější:
InsertProfileItems
proc InsertProfileItems {tree id} {
set parent "profile::$id"
set lst {
{dir "Virtuální adresáře"}
{com "Povolené COM třídy"}
{addin "Externí komponenty"}
{module "Externí zprávy a zpracování"}
{app "Povolené aplikace"}
{inet "Internetové zdroje"}
}
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
}
}Rozdíl mezi nimi spočívá v aplikaci cyklu, v němž se provádí opakovaný příkaz (příkazy). Jaký přístup použít — je již na rozhodnutí vývojáře.
Přidání prvků a získání dat jsme probrali, nyní je čas zastavit se u úprav. Protože pro úpravy a přidání se většinou používají stejné parametry (výjimku tvoří informační databáze), budou také dialogové formuláře použity shodně. Algoritmus pro volání procedur pro přidání vypadá takto:
Add::$key->AddToplevel
A pro úpravy takto:
Edit::$key->Add::$key->AddTopLevel
Pro příklad si vezmeme úpravu clusteru, tj. po kliknutí na název clusteru v stromě stiskneme tlačítko úpravy na panelu nástrojů (tužka) a na obrazovce se zobrazí příslušný formulář:
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 ""
}
# vykreslujeme formulář pro klastr
set frm [Add::cluster $tree $host $values]
# měníme text na štítku
$frm configure -text "Úprava clusteru"
set active_cluster $values
# získáváme data o vybraném clusteru
set lst [RunCommand cluster::$values "cluster info --cluster=$active_cluster $host"]
# vyplňujeme pole
FormFieldsDataInsert $frm $lst
# zakazujeme editaci polí
$frm.ent_host configure -state disable
$frm.ent_port configure -state disable
# přeřazujeme obslužnou rutinu
.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
}
}Podle komentářů v kódu je v podstatě vše jasné, kromě toho, že obslužná rutina tlačítka byla přepsána a existuje procedura FormFieldsDataInsert, která naplňuje pole daty a inicializuje proměnné:
FormFieldsDataInsert
proc FormFieldsDataInsert {frm lst} {
foreach i [lindex $lst 0] {
# získáváme seznam parametrů a hodnot
if [regexp -nocase -all -- {(D+)(s*?|)(:)(s*?|)(.*)} $i match param v2 v3 v4 value] {
# měníme znaky
regsub -all -- "-" [string trim $param] "_" entry_name
# vyplňujeme daty
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 """]
}
# pro checkboxy měníme hodnoty
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
}
}
}
}
}
V tomto procesu se objevil další klad tcl — jako názvy proměnných se vkládají hodnoty jiných proměnných. To znamená, že pro automatizaci vyplňování formulářů a inicializaci proměnných odpovídají názvy polí a proměnných klíčům příkazového řádku nástroje rac a názvům parametrů výstupu příkazů s určitými výjimkami — pomlčka je nahrazena podtržítkem. Například scheduled-jobs-deny odpovídá poli ent_scheduled_jobs_deny a proměnné scheduled_jobs_deny.
Formuláře pro přidávání a úpravy se mohou lišit složením polí, například práce s informační bází:
Přidání IB
Úprava IB
V proceduře úpravy Edit::infobase se na formulář přidávají požadovaná pole, kód je objemný, proto ho zde neuvedu.
Analogicky byly implementovány procedury přidání, úpravy, odstranění a pro ostatní prvky.
Jelikož provoz nástroje předpokládá neomezený počet serverů, klastry, informační báze atd., byly zavedeny některé globální proměnné, jejichž hodnoty se nastavují při každém kliknutí na prvky stromu. To znamená, že procedura rekurzivně prochází všechny nadřazené prvky a nastavuje proměnné:
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
}
}
Cluster 1C umožňuje práci jak s autorizací, tak bez. Existují dva typy správců — správce agenta clusteru a správce clusteru. Odpovídajícím způsobem pro správnou funkci byly zavedeny ještě 4 globální proměnné obsahující uživatelské jméno a heslo správce. Tedy pokud v clusteru existuje účet správce, objeví se dialog pro zadání uživatelského jména a hesla, data budou uložena v paměti a použita v každém příkazu pro odpovídající cluster.
Na to dohlíží procedura pro zpracování chyb
ErrorParcing
proc ErrorParcing {err opt} {
global cluster_user cluster_pwd agent_user agent_pwd
switch -regexp -- $err {
"Cluster administrator is not authenticated" {
AuthorisationDialog "Administrátor clustera"
.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 "Administrátor agenta clustera"
.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
}
}
"Administrátor clustera není ověřen" {
AuthorisationDialog "Administrátor clustera"
.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
}
"Administrátor centrálního serveru není ověřen" {
AuthorisationDialog "Administrátor agenta clustera"
.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"
}
}
}To znamená, v závislosti na tom, co příkaz vrátí, bude odpověď odpovídající.
V současné době je funkcionalita realizována asi na 95 %, zbývá doladit práci s bezpečnostními profily a otestovat to =). Tím končím. Omlouvám se za zkrácené vyprávění.
Kód, jak je tradicí, je k dispozici. .
Aktualizace: Dopracoval jsem práci s bezpečnostními profily. Nyní je funkcionalita realizována na 100 %.
Aktualizace 2: přidána lokalizace do angličtiny a ruštiny, zkontrolována funkčnost na Windows 7.
Zdroj: habr.com
