Pišemo GUI za 1C RAC, ili ponovo o Tcl/Tk

S spoznavanjem tematike delovanja 1C produktov v okolju Linux sem odkril eno pomanjkljivost — pomanjkanje priročnega grafičnega večplatformskega orodja za upravljanje s skupino 1C strežnikov. Odločeno je bilo, da to pomanjkljivost odpravimo z razvojem GUI za konzolno orodje rac. Jezik, ki je bil izbran za razvoj, je tcl/tk, saj se mi zdi najbolj primeren za to nalogo. Tukaj bi rad predstavil nekaj zanimivih vidikov rešitve.

Za delo bodo potrebne distribucije tcl/tk in 1C. Ker sem se odločil, da bom maksimalno izkoristil možnosti osnovne različice tcl/tk brez uporabe zunanjih paketov, je potrebna različica 8.6.7, ki vključuje ttk — paket z dodatnimi grafičnimi elementi, od katerih bomo potrebovali predvsem ttk::TreeView, ki omogoča prikaz podatkov tako v drevesni strukturi kot tudi v obliki tabele (seznama). Poleg tega je v novi različici izboljšano delo z izjemami (ukaz try, ki ga projekt uporablja pri zagonu zunanjih ukazov).

Projekt je sestavljen iz več datotek (čeprav ni nič narobe, če naredite vse v eni):

rac_gui.cfg — privzeta konfiguracija
rac_gui.tcl — glavni zagon skripte
V mapi lib so datoteke, ki se samodejno naložijo ob zagonu:
function.tcl — datoteka s postopki
gui.tcl — glavni grafični vmesnik
images.tcl — knjižnica slik v base64

Datoteka rac_gui.tcl dejansko zažene interpreter, inicializira spremenljivke, naloži module, konfiguracije in tako dalje. Vsebina datoteke s komentarji:

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 nalaganju vsega, kar je potrebno, in preverjanju prisotnosti orodja rac, bo odprto grafično okno. Vmesnik programa je sestavljen iz treh elementov:

Orodna vrstica, drevo in seznam

Vsebina 'drevesa' je čim bolj podobna privzeti Windows komponenti od 1C.

Pišemo GUI za 1C RAC, ili ponovo o Tcl/Tk

Glavna koda, ki oblikuje to okno, se nahaja v datoteki
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

Algoritem za delo s programom je naslednji:

1. Najprej morate dodati glavni strežnik skupine (tj. strežnik za upravljanje skupine (v Linuxu se upravljanje zažene z ukazom „/opt/1C/v8.3/x86_64/ras cluster —daemon“)).

Za to pritisnite gumb „+“ in v odprtem oknu vnesite naslov strežnika in vrata:

Pišemo GUI za 1C RAC, ili ponovo o Tcl/Tk

Nato se bo v drevesu pojavil naš strežnik, na katerega klikom se bo odprl seznam skupin ali pa bo prikazana napaka pri povezovanju.

2. Klikom na ime klastera će se otvoriti lista funkcija dostupnih za njega.

3.…

Dakle, da bismo dodali novi klaster, odabiremo bilo koji dostupan u listi i pritisnemo dugme „+” u alatnoj traci, a zatim će se otvoriti dijalog za dodavanje novog:

Pišemo GUI za 1C RAC, ili ponovo o Tcl/Tk

Dugmad u alatnoj traci izvršavaju funkcije u zavisnosti od konteksta, tj. od toga koji je element stabla ili liste odabran, izvršiće se odgovarajuća procedura.

Razmotrićemo na primeru dugmeta za dodavanje („+”):

Kod za formiranje dugmeta:

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

Ovde vidimo da će pritiskom na dugme biti izvršena procedura „Add”, a njen kod:

proc Add {} {
    global active_cluster host
    # Definišemo identifikator odabranog elementa
    set id  [.frm_tree.tree selection] 
    # Definišemo vrednost ovog elementa
    set values [.frm_tree.tree item [.frm_tree.tree selection] -values]
    set key [lindex [split $id "::"] 0]
    # u zavisnosti od onoga što smo odabrali biće pokrenuta potrebna procedura
    if {$key eq "" || $key eq "server"} {
        set host [ Add::server ]
        return
    }
    Add::$key .frm_tree.tree $host $values
}

I evo se nazire jedna od prednosti tiklya — kao ime procedure može se proslediti vrednost promenljive:

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

Dakle, na primer, ako kliknemo na glavni server i pritisnemo „+”, biće pokrenuta procedura Add::server, ako na klaster — Add::cluster itd. (o tome odakle dolaze potrebni „ključevi” pisaću malo kasnije), navedene procedure prikazuju grafičke elemente koji odgovaraju kontekstu.

Kao što ste već mogli primetiti, forme su stilizovane na sličan način — to i nije iznenađenje, jer se prikazuju jednom procedurom, tačnije osnovnim okvirom forme (prozor, dugmad, slika, oznaka), naziv procedure 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
    # oznaka sa ikonom
    ttk::label $win_name.lbl -image $img
    # okvir sa poljima za unos
    set frm [ttk::labelframe $win_name.frm -text $lbl -labelanchor nw]
    
    grid columnconfigure $frm 0 -weight 1
    grid rowconfigure $frm 0 -weight 1
    # okvir i dugmad
    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
}

Parametri klica: naslov, ime slike za ikono iz biblioteke (lib/images.tcl) in opcijski parameter ime okna (privzeto .add). Tako bo, če vzamemo zgoraj navedene primere za dodajanje glavnega strežnika in klasterja, klic ustrezno:

AddToplevel "Dodajanje glavnega strežnika" server_grey_64

ili

AddToplevel "Dodajanje klasterja" cluster_grey_64

In nadaljujem s temi primeri, bom pokazal postopke, ki prikazujejo dialoge za dodajanje strežnika ali klasterja.

Add::server

proc Add::server {} {
    global default
    # prikažemo glavno obliko
    set frm [AddToplevel "Dodajanje glavnega strežnika" server_grey_64]
    # dodamo oznake in vnosna polja na to obliko
    label $frm.lbl_host -text "Naslov strežnika"
    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]
    # predefiniramo obravnavo pritiska gumba
    .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 "Dodajanje grozda" cluster_grey_64]
    
    label $frm.lbl_host -text "Naslov glavnega strežnika"
    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 "Ime grozda"
    entry  $frm.ent_name
    label $frm.lbl_secure_connect -text "Zavarovana povezava"
    ttk::combobox $frm.cb_security_level -textvariable security_level -values $default(security_level)
    label $frm.lbl_expiration_timeout -text "Ustavi izklopljene procese po:"
    entry  $frm.ent_expiration_timeout -textvariable expiration_timeout
    label $frm.lbl_session_fault_tolerance_level -text "Stopnja odpornosti na napake"
    entry  $frm.ent_session_fault_tolerance_level -textvariable session_fault_tolerance_level
    label $frm.lbl_load_balancing_mode -text "Način obremenitve"
    ttk::combobox $frm.cb_load_balancing_mode -textvariable load_balancing_mode 
    -values $default(load_balancing_mode)
    label $frm.lbl_errors_count_threshold -text "Dovoljeno odstopanje števila napak strežnika, %"
    entry  $frm.ent_errors_count_threshold -textvariable errors_count_threshold
    label $frm.lbl_processes -text "Delovni procesi:"
    label $frm.lbl_lifetime_limit -text "Obdobje ponovnega zagona, sek."
    entry  $frm.ent_lifetime_limit -textvariable lifetime_limit
    label $frm.lbl_max_memory_size -text "Dovoljeno število pomnilnika, KB"
    entry  $frm.ent_max_memory_size -textvariable max_memory_size
    label $frm.lbl_max_memory_time_limit -text "Interval presežka dovoljenega števila pomnilnika, sek."
    entry  $frm.ent_max_memory_time_limit -textvariable max_memory_time_limit
    label $frm.lbl_kill_problem_processes -justify left -anchor nw -text "Prisilno končaj problematične procese"
    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 свойства графических элементов можно переопределять во время выполнения программы с помощью опции configure. Например, изначальная команда для вывода кнопки:

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"

Теперь щелкнув по имени сервера в дереве, мы получим список кластеров управляемых оным сервером, а щелкнув на кластере, получим список элементов кластера (strežnikov, информационных баз и т.д.). Реализовано это в процедуре 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} {
    # pridobitev seznama grozdov zahtevanega strežnika
    set lst [RunCommand server::$host "cluster list $host"]
    if {$lst eq ""} {return}
    set l [lindex $lst 0]
    #puts $lst
    # odstranitev odvečnega s seznama
    .frm_work.tree_work delete  [ .frm_work.tree_work children {}]
    # beremo seznam
    foreach cluster_list $lst {
        # Napolnimo seznam s pridobljenimi vrednostmi
        InsertItemsWorkList $cluster_list
        # obdelava izhoda (seznam) za dodajanje podatkov v drevo
        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]]
            }
        }
    }
    # dodajamo grozde v drevo
    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"
            # dodajanje elementov v grozd
            InsertClusterItems $tree $id
        }
    }
    if { [$tree exists "agent_admins::$id"] == 0 } {
        $tree insert "server::$host" end -id "agent_admins::$id" -text "Administratorji" -values "$id"
        #InsertClusterItems $tree $id
    }
}

Ta postopek obdeluje podatke, pridobljene od strežnika prek ukaza RunCommand, in dodaja različne elemente v drevo – grozde, različne korenske elemente (podatkovne baze, delovne strežnike, seje in tako naprej). Če se poglobite, lahko opazite klic postopka InsertItemsWorkList. Uporablja se za dodajanje elementov v grafični seznam, ki obdeluje izhod konzolne zmogljivosti rac, ki je bil prej vrnjen v spremenljivko $lst kot seznam. To je seznam seznamov, ki vsebuje pare elementov, ločene z dvopičjem.

Na primer, seznam povezav grozda:

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

V grafični obliki bi to izgledalo približno tako:

Pišemo GUI za 1C RAC, ili ponovo o Tcl/Tk

Zgornji postopek izloča imena elementov za naslov in podatke za izpolnitev tabele:

InsertItemsWorkList

proc InsertItemsWorkList {lst} {
    global work_list_row_count
    # nastavitveno barvno izmenjavo za vrstico
    if [expr $work_list_row_count % 2] {
        set tag dark
    } else {
        set tag light
    }
    # razčlenitev vrstic na pare ključ - vrednost
    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]
        }
    }
     # izpolnitev tabele
    .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
    # nastavitveno glave
    foreach j $column_list {
        .frm_work.tree_work heading $j -text $j
    }
    incr work_list_row_count
}

Tukaj je namesto preproste ukaze [split $str «:»], ki razčleni niz na sestavne dele ločene z «:» in vrne seznam, uporabljena redna izraza, ker nekateri elementi prav tako vsebujejo dvotočje.

Postopek InsertClusterItems (eden izmed več podobnih) preprosto doda v drevo zahtevano elementu cluster seznam podrejenih elementov s pripadajočimi identifikatorji.
InsertClusterItems

proc InsertClusterItems {tree id} {
    set parent "cluster::$id"
    $tree insert $parent end -id "infobases::$id" -text "Informacijske baze" -values "$id"
    $tree insert $parent end -id "servers::$id" -text "Delo strežnikov" -values "$id"
    $tree insert $parent end -id "admins::$id" -text "Administratorji" -values "$id"
    $tree insert $parent end -id "managers::$id" -text "Managerji grozda" -values $id
    $tree insert $parent end -id "processes::$id" -text "Dela procesi" -values "workprocess-all"
    $tree insert $parent end -id "sessions::$id" -text "Seje" -values "sessions-all"
    $tree insert $parent end -id "locks::$id" -text "Zaklepi" -values "blocks-all"
    $tree insert $parent end -id "connections::$id" -text "Povezave" -values "connections-all"
    $tree insert $parent end -id "profiles::$id" -text "Varnostni profili" -values $id
}

Lahko razmislimo še o dveh možnostih za izvajanje podobnega postopka, kjer bo jasno prikazano, kako lahko optimiziramo in se znebimo ponavljajočih se ukazov:

V tem postopku je dodajanje in preverjanje rešeno odločno:

InsertBaseItems

proc InsertBaseItems {tree id} {
    set parent "infobase::$id"
    if { [$tree exists "sessions::$id"] == 0 } {
        $tree insert $parent end -id "sessions::$id" -text "Seje" -values "$id"
    }
    if { [$tree exists "locks::$id"] == 0 } {
        $tree insert $parent end -id "locks::$id" -text "Zaklepi" -values "$id"
    }
    if { [$tree exists "connections::$id"] == 0 } {
        $tree insert $parent end -id "connections::$id" -text "Povezave" -values "$id"
    }
}

Tukaj je pristop bolj pravilen:

InsertProfileItems

proc InsertProfileItems {tree id} {
    set parent "profile::$id"
    set lst {
        {dir "Virtualni direktoriji"}
        {com "Dozvoljene COM-klase"}
        {addin "Vanjske komponente"}
        {module "Vanjski izvještaji i obrade"}
        {app "Dozvoljene aplikacije"}
        {inet "Internet resursi"}
    }
    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 
    }
}

Razlika između njih je u primjeni petlje, u kojoj se izvršava ponavljajuća naredba (naredbe). Koji pristup primijeniti — to je već na prosudbu programera.

Dodavanje elemenata i dobivanje podataka smo razmatrali, sada je pravo vrijeme da se osvrnemo na uređivanje. Budući da se, uglavnom, za uređivanje i dodavanje koriste isti parametri (izuzetak čini informacijska baza), i dijaloške forme su iste. Algoritam poziva procedura za dodavanje izgleda ovako:

Add::$key->AddToplevel

A za uređivanje ovako:

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

Na primjer, uzmimo uređivanje klastera, tj. klikom na naziv klastera u stablu, pritisnemo dugme za uređivanje na alatnoj traci (olovka) i na ekranu će se prikazati odgovarajući oblik:

Pišemo GUI za 1C RAC, ili ponovo 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 ""
    }
    # создаем форму для кластера
    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
                }
            }
        }
    }
}

V tej proceduri se je pojavil še en plus tcl — kot imena spremenljivk se uporabijo vrednosti drugih spremenljivk. To pomeni, da za avtomatizacijo izpolnjevanja obrazcev in inicializacijo spremenljivk imena polj in spremenljivk ustrezajo ključem ukazne vrstice orodja rac in imenom parametrov izhoda ukazov z nekaterimi izjemo — znak minus je zamenjan s podčrtajem. Na primer scheduled-jobs-deny ustreza polju ent_scheduled_jobs_deny in spremenljivki scheduled_jobs_deny.

Obrazci za dodajanje in urejanje se lahko razlikujejo po sestavi polj, na primer, delo z informacijskim sistemom:

Dodajanje IS

Pišemo GUI za 1C RAC, ili ponovo o Tcl/Tk

Urejanje IS

Pišemo GUI za 1C RAC, ili ponovo o Tcl/Tk

V postopku urejanja Edit::infobase se na obrazec dodajo zahtevana polja, koda je obsežna, zato je tu ne navajam.

Podobno so bile izvedene procedure dodajanja, urejanja, brisanja in za preostale elemente.

Ker delo orodja predpostavlja neomejeno število strežnikov, grozdov, informacijskih baz itd., so bile za določitev, kateremu grozdu pripada kateri strežnik ali IS, uvedene nekatere globalne spremenljivke, katere vrednosti se nastavljajo ob vsakem kliku na elemente drevesa. To pomeni, da postopek rekurzivno prehaja skozi vse starševske elemente in nastavi spremenljivke:

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

Grozd 1C omogoča delo tako z avtorizacijo kot brez. Obstajata dva tipa administratorjev — administrator agenta grozda in administrator grozda. Ustrezno za pravilno delovanje so bile uvedene še 4 globalne spremenljivke, ki vsebujejo uporabniško ime in geslo administratorja. To pomeni, da če v grozdu obstaja račun administratorja, se bo prikazal dialog za vnos uporabniškega imena in gesla, podatki bodo shranjeni v pomnilniku in uporabljeni v vsakem ukazu za ustrezen grozd.

Za to je odgovorna procedura obravnave napak

ErrorParcing

proc ErrorParcing {err opt} {
    global cluster_user cluster_pwd agent_user agent_pwd
        switch -regexp -- $err {
        "Cluster administrator is not authenticated" {
            AuthorisationDialog "Administrator klastera"
            .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 "Administrator agenta klastera"
            .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 "Administrator klastera"
            .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 "Administrator agenta klastera"
            .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 jest, w zależności od tego, co zwraca polecenie, będzie odpowiednia reakcja.

Na ten moment funkcjonalność została zrealizowana w około 95%, pozostało jeszcze zrealizować pracę z profilami zabezpieczeń oraz przetestować =). To wszystko. Przepraszam za chaotyczną narrację.

Kod, tradycyjnie, jest dostępny tukaj.

Aktualizacja: Zakończyłem pracę nad profilami zabezpieczeń. Teraz funkcjonalność została zrealizowana w 100%.

Aktualizacja 2: dodano lokalizację na angielski i rosyjski, sprawdzono działanie na win7
Pišemo GUI za 1C RAC, ili ponovo o Tcl/Tk

Izvor: habr.com

Kupite zanesljivo gostovanje za spletne strani z zaščito pred DDoS, VPS VDS strežniki 🔥 Kupite zanesljivo gostovanje za spletne strani z zaščito pred DDoS, VPS VDS strežniki | ProHoster