Pisząc GUI do 1C RAC, czyli znowu o Tcl/Tk

W miarę zagłębiania się w temat pracy z produktami 1C w środowisku Linux, odkryłem jeden mankament — brak wygodnego, wieloplatformowego narzędzia do zarządzania klastrem serwerów 1C. Zdecydowano więc, by ten brak naprawić, pisząc GUI dla konsolowego narzędzia rac. Jako język programowania wybrano Tcl/Tk, który według mnie najlepiej pasuje do tego zadania. Oto niektóre interesujące aspekty rozwiązania, które chciałbym przedstawić w tym materiale.

Do pracy będą potrzebne dystrybucje Tcl/Tk oraz 1C. A ponieważ postanowiłem maksymalnie wykorzystać możliwości podstawowej wersji Tcl/Tk bez użycia dodatkowych pakietów, potrzebna będzie wersja 8.6.7, która zawiera ttk — pakiet z dodatkowymi elementami graficznymi, z których potrzebujemy głównie ttk::TreeView, umożliwiający wyświetlanie danych zarówno w formie struktury drzewiastej, jak i w postaci tabeli (listy). Ponadto w nowej wersji przebudowano obsługę wyjątków (komenda try, która w projekcie jest używana przy uruchamianiu zewnętrznych poleceń).

Projekt składa się z kilku plików (choć nic nie stoi na przeszkodzie, aby wszystko zrobić w jednym):

rac_gui.cfg — domyślny plik konfiguracyjny
rac_gui.tcl — główny skrypt uruchamiający
W katalogu lib znajdują się pliki automatycznie ładowane przy starcie:
function.tcl — plik z procedurami
gui.tcl — główny interfejs graficzny
images.tcl — biblioteka obrazów w base64

Plik rac_gui.tcl uruchamia interpreter, inicjalizuje zmienne, ładuje moduły, konfiguracje itd. Zawartość pliku z komentarzami:

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 załadowaniu wszystkiego, co potrzebne, i sprawdzeniu obecności narzędzia rac, zostanie uruchomione okno graficzne. Interfejs programu składa się z trzech elementów:

Panel narzędzi, drzewo i lista

Zawartość „drzewa” starałem się maksymalnie upodobnić do standardowego komponentu Windows od 1C.

Pisząc GUI do 1C RAC, czyli znowu o Tcl/Tk

Główny kod tworzący to okno znajduje się w pliku
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

Algorytm pracy z programem jest następujący:

1. Na początku trzeba dodać główny serwer klastra (tj. serwer zarządzający klastrem (w Linux zarządzanie uruchamia się komendą „/opt/1C/v8.3/x86_64/ras cluster —daemon”).

W tym celu kliknij przycisk „+”, a w otwartym oknie wprowadź adres serwera i port:

Pisząc GUI do 1C RAC, czyli znowu o Tcl/Tk

Po kliknięciu w drzewo, pojawi się nasz serwer, a po jego kliknięciu otworzy się lista klastrów lub wyświetli się błąd połączenia.

2. Klikając na nazwę klastra, otworzy się lista dostępnych funkcji.

3.…

W celu dodania nowego klastra, wybieramy dowolny dostępny w liście i klikamy przycisk „+” na pasku narzędzi, na co zostanie wyświetlone okno dodawania nowego:

Pisząc GUI do 1C RAC, czyli znowu o Tcl/Tk

Przyciski na pasku narzędzi wykonują funkcje w zależności od kontekstu, tzn. w zależności od tego, jaki element drzewa lub listy jest wybrany, zostanie wykonana odpowiednia procedura.

Rozważmy na przykładzie przycisku dodawania („+”):

Kod tworzenia przycisku:

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

Widzimy tu, że po naciśnięciu przycisku zostanie wykonana procedura „Add”, jej kod:

proc Add {} {
    global active_cluster host
    # Określamy identyfikator wybranego elementu
    set id  [.frm_tree.tree selection] 
    # Określamy wartość tego elementu
    set values [.frm_tree.tree item [.frm_tree.tree selection] -values]
    set key [lindex [split $id "::"] 0]
    # w zależności od tego, co wybraliśmy, będzie uruchomiona odpowiednia procedura
    if {$key eq "" || $key eq "server"} {
        set host [ Add::server ]
        return
    }
    Add::$key .frm_tree.tree $host $values
}

Tu odkrywa się jedna z zalet tickle — jako nazwę procedury można przekazać wartość zmiennej:

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

Tzn., jeśli na przykład klikniemy główny serwer i naciśniemy „+”, zostanie uruchomiona procedura Add::server, jeśli w klaster — Add::cluster i tak dalej (o tym, skąd biorą się potrzebne „klucze”, napiszę nieco później), wymienione procedury rysują odpowiednie elementy graficzne zgodne z kontekstem.

Jak już mogliście zauważyć, formularze są stylowo podobne — to nie dziwi, bo są wyświetlane jedną procedurą, a dokładniej główną konstrukcją formularza (okno, przyciski, obrazek, etykieta), nazwą 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
    # etykieta z ikoną
    ttk::label $win_name.lbl -image $img
    # ramka z polami wejściowymi
    set frm [ttk::labelframe $win_name.frm -text $lbl -labelanchor nw]
    
    grid columnconfigure $frm 0 -weight 1
    grid rowconfigure $frm 0 -weight 1
    # ramka i przyciski
    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 wywołania: tytuł, nazwa obrazu ikony z biblioteki (lib/images.tcl) oraz opcjonalny parametr nazwa okna (domyślnie .add). Tak więc, biorąc powyższe przykłady dla dodania głównego serwera i klastra, wywołanie będzie odpowiednio:

AddToplevel "Dodawanie głównego serwera" server_grey_64

lub

AddToplevel "Dodawanie klastra" cluster_grey_64

Kontynuując te przykłady, pokażę procedury, które wyświetlają dialogi dodawania dla serwera lub klastra.

Add::server

proc Add::server {} {
    global default
    # wyświetlamy główny formularz
    set frm [AddToplevel "Dodawanie głównego serwera" server_grey_64]
    # dodajemy etykiety i pola wejściowe do tego formularza
    label $frm.lbl_host -text "Adres serwera"
    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]
    # redefiniujemy handler przycisku
    .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 ""
    }
    # ustawiamy globalne zmienne ()
    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 "Dodaj klaster" cluster_grey_64]
    
    label $frm.lbl_host -text "Adres głównego serwera"
    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 "Nazwa klastra"
    entry  $frm.ent_name
    label $frm.lbl_secure_connect -text "Bezpieczne połączenie"
    ttk::combobox $frm.cb_security_level -textvariable security_level -values $default(security_level)
    label $frm.lbl_expiration_timeout -text "Zatrzymuj wyłączone procesy po:"
    entry  $frm.ent_expiration_timeout -textvariable expiration_timeout
    label $frm.lbl_session_fault_tolerance_level -text "Poziom odporności na awarie"
    entry  $frm.ent_session_fault_tolerance_level -textvariable session_fault_tolerance_level
    label $frm.lbl_load_balancing_mode -text "Tryb rozkładania obciążenia"
    ttk::combobox $frm.cb_load_balancing_mode -textvariable load_balancing_mode 
    -values $default(load_balancing_mode)
    label $frm.lbl_errors_count_threshold -text "Dopuszczalne odchylenie liczby błędów serwera, %"
    entry  $frm.ent_errors_count_threshold -textvariable errors_count_threshold
    label $frm.lbl_processes -text "Procesy robocze:"
    label $frm.lbl_lifetime_limit -text "Okres ponownego uruchomienia, sek."
    entry  $frm.ent_lifetime_limit -textvariable lifetime_limit
    label $frm.lbl_max_memory_size -text "Dopuszczalna ilość pamięci, KB"
    entry  $frm.ent_max_memory_size -textvariable max_memory_size
    label $frm.lbl_max_memory_time_limit -text "Czas przekroczenia dopuszczalnej ilości pamięci, sek."
    entry  $frm.ent_max_memory_time_limit -textvariable max_memory_time_limit
    label $frm.lbl_kill_problem_processes -justify left -anchor nw -text "Wymuś zakończenie problematycznych procesów"
    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
    # redefiniujemy obsługę
    .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
}

Porównując kod tych procedur, różnica jest widoczna gołym okiem, zwrócę uwagę na obsługę przycisku „Ok”. W Tk właściwości elementów graficznych można nadpisywać w czasie wykonywania programu za pomocą opcji configure. Na przykład, początkowa komenda wyświetlenia przycisku:

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

Jednak w naszych formularzach komenda zależy od wymaganej funkcjonalności:

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

W powyższym przykładzie przycisk „zainicjowany” uruchamia procedurę dodania klastra.

Warto w tym miejscu zrobić dygresję na temat pracy z elementami graficznymi w Tk — dla różnych elementów wprowadzania danych (entry, combobox, checkbutton itd.) wprowadzono taki parametr jak zmienna tekstowa (textvariable):

entry  $frm.ent_lifetime_limit -textvariable lifetime_limit

Zmienna ta jest zdefiniowana w globalnej przestrzeni nazw i zawiera aktualnie wprowadzoną wartość. To znaczy, aby uzyskać wprowadzony tekst z pola, należy po prostu odczytać wartość odpowiadającej jej zmiennej (oczywiście pod warunkiem, że została zdefiniowana przy tworzeniu elementu).

Drugą metodą uzyskania wprowadzonego tekstu (dla elementów typu entry) jest użycie komendy get:

.add.frm.ent_name get

Obie te metody można zobaczyć w powyższym kodzie.

Naciśnięcie tego przycisku, w tym przypadku, uruchamia procedurę RunCommand z utworzoną linią komendy dodania klastra w terminach 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

Oto dotarliśmy do głównej komendy, która zarządza uruchomieniem rac z potrzebnymi nam parametrami, również analizuje wynik komend na listy i zwraca, jeśli to konieczne:

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
    # otwieramy kanał w trybie nieblokującym
    # $rac - komenda z pełną ścieżką
    # $par - utworzone klucze uruchamiania i opcje    
    set pipe [open "|$rac_cmd $par" "r"]
    try {
        set lst ""
        set l ""
        # dodajemy wyjście komendy do listy list
        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} {
        # Uruchamiamy funkcję obsługi błędów
        ErrorParcing $result $options
        return ""
    }
}

Po wprowadzeniu danych głównego serwera zostanie on dodany do drzewa, za co w powyższej procedurze Add:server odpowiada następujący kod:

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

Teraz klikając nazwę serwera w drzewie, otrzymamy listę klastrów zarządzanych przez ten serwer, a klikając na klaster, uzyskamy listę elementów klastra (serwerów, baz danych itd.). Zrealizowano to w procedurze TreePress (plik lib/function.tcl):

proc TreePress {tree} {
   global host server active_cluster infobase
   # określamy zaznaczony element
    set id  [$tree selection]
   # ustawiamy potrzebne globalne zmienne
    SetGlobalVarFromTreeItems $tree $id
   # Określamy klucz i wartość, tzn. typ wybranego elementu
    set values [$tree item $id -values]
    set key [lindex [split $id "::"] 0]
   # i w zależności od tego co wybrano uruchomiona zostanie odpowiednia procedura 
   # w przestrzeni nazw Run
    Run::$key $tree $host $values
}

Oczywiście, dla głównego serwera uruchomi się Run::server (dla klastra — Run::cluster, dla serwera roboczego — Run::work_server itd.). Tzn. wartość zmiennej $key to część nazwy elementu drzewa, określana opcją -id.

Zwróćmy uwagę na procedurę

Run::server

proc Run::server {tree host values} {
    # pobierz listę klastrów wymaganego serwera
    set lst [RunCommand server::$host "cluster list $host"]
    if {$lst eq ""} {return}
    set l [lindex $lst 0]
    #puts $lst
    # usuń zbędne z listy
    .frm_work.tree_work delete  [ .frm_work.tree_work children {}]
    # odczytaj listę
    foreach cluster_list $lst {
        # Wypełnij listę otrzymanymi wartościami
        InsertItemsWorkList $cluster_list
        # przetwarzamy wynik (listę) aby dodać dane do drzewa
        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]]
            }
        }
    }
    # dodaj klastry do drzewa
    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"
            # dodaj elementy do klastra
            InsertClusterItems $tree $id
        }
    }
    if { [$tree exists "agent_admins::$id"] == 0 } {
        $tree insert "server::$host" end -id "agent_admins::$id" -text "Administratorzy" -values "$id"
        #InsertClusterItems $tree $id
    }
}

Ta procedura przetwarza to, co zostało odebrane z serwera za pomocą polecenia RunCommand, i dodaje różne elementy do drzewa — klastry, różne elementy główne (bazy, serwery robocze, sesje itd.). Jeśli się przyjrzysz, w środku można zauważyć wywołanie procedury InsertItemsWorkList. Jest ona używana do dodawania elementów do graficznej listy, przetwarzając wyjście konsolowej użyteczności rac, które wcześniej zostało zwrócone w postaci listy do zmiennej $lst. Jest to lista list, zawierająca pary elementów oddzielonych dwukropkiem.

Na przykład, lista połączeń klastra:

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

W wizualnej formie będzie to wyglądać mniej więcej tak:

Pisząc GUI do 1C RAC, czyli znowu o Tcl/Tk

Wyżej wspomniana procedura wydobywa nazwy elementów do nagłówka i dane do wypełnienia tabeli:

InsertItemsWorkList

proc InsertItemsWorkList {lst} {
    global work_list_row_count
    # ustawienie naprzemiennego koloru dla wiersza
    if [expr $work_list_row_count % 2] {
        set tag dark
    } else {
        set tag light
    }
    # przetwarzanie wierszy na pary klucz - wartość
    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]
        }
    }
     # wypełnianie tabeli
    .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
    # ustawienie nagłówków
    foreach j $column_list {
        .frm_work.tree_work heading $j -text $j
    }
    incr work_list_row_count
}

Zamiast prostej komendy [split $str «:»], która dzieli ciąg na elementy oddzielone «:» i zwraca listę, zastosowano wyrażenie regularne, ponieważ niektóre elementy także zawierają dwukropek.

Procedura InsertClusterItems (jedna z kilku podobnych) po prostu dodaje do drzewa do wymaganego elementu cluster listę elementów podrzędnych z odpowiednimi identyfikatorami.
InsertClusterItems

proc InsertClusterItems {tree id} {
    set parent "cluster::$id"
    $tree insert $parent end -id "infobases::$id" -text "Bazy informacyjne" -values "$id"
    $tree insert $parent end -id "servers::$id" -text "Serwery robocze" -values "$id"
    $tree insert $parent end -id "admins::$id" -text "Administratorzy" -values "$id"
    $tree insert $parent end -id "managers::$id" -text "Menadżerowie klastra" -values $id
    $tree insert $parent end -id "processes::$id" -text "Procesy robocze" -values "workprocess-all"
    $tree insert $parent end -id "sessions::$id" -text "Sesje" -values "sessions-all"
    $tree insert $parent end -id "locks::$id" -text "Blokady" -values "blocks-all"
    $tree insert $parent end -id "connections::$id" -text "Połączenia" -values "connections-all"
    $tree insert $parent end -id "profiles::$id" -text "Profile bezpieczeństwa" -values $id
}

Można rozważyć jeszcze dwie opcje realizacji podobnej procedury, gdzie będzie wyraźnie widać, jak można zoptymalizować i pozbyć się powtarzających się poleceń:

W tej procedurze dodawanie i sprawdzanie zostało rozwiązane bezpośrednio:

InsertBaseItems

proc InsertBaseItems {tree id} {
    set parent "infobase::$id"
    if { [$tree exists "sessions::$id"] == 0 } {
        $tree insert $parent end -id "sessions::$id" -text "Sesje" -values "$id"
    }
    if { [$tree exists "locks::$id"] == 0 } {
        $tree insert $parent end -id "locks::$id" -text "Blokady" -values "$id"
    }
    if { [$tree exists "connections::$id"] == 0 } {
        $tree insert $parent end -id "connections::$id" -text "Połączenia" -values "$id"
    }
}

A tutaj podejście jest bardziej poprawne:

InsertProfileItems

proc InsertProfileItems {tree id} {
    set parent "profile::$id"
    set lst {
        {dir "Wirtualne katalogi"}
        {com "Zezwolenia na klasy COM"}
        {addin "Zewnętrzne komponenty"}
        {module "Zewnętrzne raporty i przetwarzanie"}
        {app "Zezwolenia na aplikacje"}
        {inet "Zasoby internetowe"}
    }
    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 
    }
}

Różnica między nimi polega na zastosowaniu pętli, w której wykonywana jest powtarzająca się komenda (komendy). Jaki podejście zastosować — to już kwestia decyzji programisty.

Dodanie elementów i pobieranie danych omówiliśmy, nadeszła pora, aby zatrzymać się na edytowaniu. Ponieważ głównie do edytowania i dodawania używane są te same parametry (wyjątek stanowi baza informacyjna), dialogi do edytowania są używane identycznie. Algorytm wywołania procedur do dodawania wygląda tak:

Add::$key->AddToplevel

A do edytowania wygląda tak:

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

Na przykład weźmy edytowanie klastra, tzn. klikając w drzewie na nazwie klastra, naciskamy przycisk edytowania na pasku narzędzi (ołówek) i na ekranie pojawi się odpowiedni formularz:

Pisząc GUI do 1C RAC, czyli znowu o 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 ""
    }
    # tworzymy formularz dla klastra
    set frm [Add::cluster $tree $host $values]
    # zmieniamy tekst na etykiecie
    $frm configure -text "Edycja klastra"
    
    set active_cluster $values
    # uzyskujemy dane dla wybranego klastra
    set lst [RunCommand cluster::$values "cluster info --cluster=$active_cluster $host"]
    # wypełniamy pola
    FormFieldsDataInsert $frm $lst
    # wyłączamy pola, których edytowanie jest zabronione
    $frm.ent_host configure -state disable
    $frm.ent_port configure -state disable
    # ponownie przypisujemy obsługiwacz
    .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
    }
}

Z komentarzy w kodzie generalnie wszystko jest jasne, z wyjątkiem tego, że kod obsługi przycisku został nadpisany, a także obecna jest procedura FormFieldsDataInsert, która wypełnia pola danymi i inicjalizuje zmienne:

FormFieldsDataInsert

proc FormFieldsDataInsert {frm lst} {
    foreach i [lindex $lst 0] {
        # uzyskujemy listę parametrów i wartości
        if [regexp -nocase -all -- {(D+)(s*?|)(:)(s*?|)(.*)} $i match param v2 v3 v4 value] {
            # zmieniamy znaki
            regsub -all -- "-" [string trim $param] "_" entry_name
            # wypełniamy danymi
            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 """]
            }
            # dla checkboxów zmieniamy wartości
            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
                }
            }
        }
    }
}

W tej procedurze ujawnia się kolejna zaleta tcl — jako nazwy zmiennych podstawiane są wartości innych zmiennych. Tzn. do automatyzacji wypełniania formularzy i inicjalizacji zmiennych, nazwy pól i zmiennych odpowiadają kluczy polecenia w narzędziu rac oraz nazwom parametrów wyjściowych komend z pewnym wyjątkiem — myślnik zastąpiony jest podkreśleniem. Na przykład scheduled-jobs-deny odpowiada polu ent_scheduled_jobs_deny i zmiennej scheduled_jobs_deny.

Formularze dodawania i edytowania mogą różnić się składem pól, na przykład, praca z bazą informacyjną:

Dodawanie IB

Pisząc GUI do 1C RAC, czyli znowu o Tcl/Tk

Edycja IB

Pisząc GUI do 1C RAC, czyli znowu o Tcl/Tk

W procedurze edytowania Edit::infobase do formularza dodawane są wymagane pola, kod jest obszerny, dlatego nie podaję go tutaj.

Analogicznie zrealizowane są procedury dodawania, edytowania, usuwania dla innych elementów.

Ponieważ praca narzędzia zakłada nieograniczoną liczbę serwerów, klastrów, baz informacyjnych itd., wprowadzono kilka globalnych zmiennych, których wartości ustalane są przy każdym kliknięciu na elementy drzewa. Tzn. procedura rekurencyjnie przechodzi przez wszystkie rodzicielskie elementy i ustawia zmienne:

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

Klaster 1C pozwala na pracę zarówno z autoryzacją, jak i bez niej. Istnieją dwa rodzaje administratorów — administrator agenta klastra i administrator klastra. Odpowiednio, dla poprawnej pracy wprowadzono jeszcze 4 globalne zmienne, zawierające login i hasło administratora. Tzn. jeśli w klastrze istnieje konto administratora, zostanie wyświetlony dialog do wprowadzenia loginu i hasła, dane będą zapisywane w pamięci i podstawiane w każdą komendę dla odpowiedniego klastra.

Za to odpowiada procedura obsługi błędów

ErrorParcing

proc ErrorParcing {err opt} {
    global cluster_user cluster_pwd agent_user agent_pwd
        switch -regexp -- $err {
        "Administrator klastra nie jest uwierzytelniony" {
            AuthorisationDialog "Administrator klastra"
            .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
        }
        "Administrator centralnego serwera nie jest uwierzytelniony" {
            AuthorisationDialog "Administrator agenta klastra"
            .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
            }
        }
        "Administrator klastra nie aутентифицирован" {
            AuthorisationDialog "Administrator klastra"
            .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
        }
        "Administrator centralnego serwera nie aутентифицирован" {
            AuthorisationDialog "Administrator agenta klastra"
            .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"
        }
    }
}

Tzn. w zależności od tego, co zwraca polecenie, będzie również reakcja.

Na chwilę obecną funkcjonalność została zrealizowana w 95%, pozostaje do zaimplementowania praca z profilami zabezpieczeń oraz przeprowadzenie testów =). To wszystko. Przepraszam za chaotyczne opowiadanie.

Kod, tradycyjnie dostępny tutaj.

Aktualizacja: Udało się zrealizować pracę z profilami zabezpieczeń. Teraz funkcjonalność została zrealizowana w 100%.

Aktualizacja 2: dodana lokalizacja w języku angielskim i rosyjskim, sprawdzono działanie w win7
Pisząc GUI do 1C RAC, czyli znowu o Tcl/Tk

Źródło: habr.com

Kup solidny hosting stron z ochroną przed DDoS, serwery VPS VDS 🔥 Kup solidny hosting stron z ochroną przed DDoS, serwery VPS VDS | ProHoster