In GUI skriuwe foar 1C RAC, of ​​wer oer Tcl / Tk

Doe't wy dûkten yn it ûnderwerp fan hoe't 1C-produkten wurkje yn 'e Linux-omjouwing, waard ien nadeel ûntdutsen - it ûntbrekken fan in handich grafysk ark foar multi-platfoarm foar it behearen fan in kluster fan 1C-tsjinners. En it waard besletten om dit tekoart te korrigearjen troch in GUI te skriuwen foar it rac-konsole-hulpprogramma. Tcl/tk is as ûntwikkelingstaal keazen as neffens my de meast geskikte foar dizze taak. En sa, ik soe graach presintearje wat nijsgjirrige aspekten fan de oplossing yn dit materiaal.

Om te wurkjen sille jo tcl / tk- en 1C-distribúsjes nedich wêze. En om't ik besletten om it measte út 'e mooglikheden fan' e basis tcl / tk-levering te meitsjen sûnder pakketten fan tredden te brûken, sil ik ferzje 8.6.7 nedich hawwe, dy't ttk omfettet - in pakket mei ekstra grafyske eleminten, wêrfan wy benammen ttk nedich binne :: TreeView, it lit gegevens werjaan sawol yn 'e foarm fan in beamstruktuer as yn' e foarm fan in tabel (list). Ek yn 'e nije ferzje is it wurk mei útsûnderingen opnij bewurke (it kommando besykje, dat wurdt brûkt yn it projekt by it útfieren fan eksterne kommando's).

It projekt bestiet út ferskate bestannen (hoewol neat jo foarkomt alles yn ien te dwaan):

rac_gui.cfg - standert konfiguraasje
rac_gui.tcl - haadstartskript
De lib-map befettet triemmen dy't automatysk laden wurde by it opstarten:
function.tcl - triem mei prosedueres
gui.tcl - haad grafyske ynterface
images.tcl - base64-ôfbyldingsbibleteek

De rac_gui.tcl triem, yn feite, begjint de tolk, inisjalisearret fariabelen, laden modules, configs, ensafuorthinne. Ynhâld fan it bestân mei opmerkings:

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

Nei it downloaden fan alles dat nedich is en it kontrolearjen fan de oanwêzigens fan it rac-hulpprogramma, sil in grafysk finster wurde lansearre. De programma-ynterface bestiet út trije eleminten:

Arkbalke, beam en list

Ik makke de ynhâld fan 'e "beam" sa ferlykber mooglik mei de standert Windows-apparatuer fan 1C.

In GUI skriuwe foar 1C RAC, of ​​wer oer Tcl / Tk

De haadkoade dy't dit finster foarmet is befette yn it bestân
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

It algoritme foar wurkjen mei it programma is as folget:

1. Earst moatte jo de haadklusterserver taheakje (dus de klusterbeheartsjinner (yn Linux wurdt behear lansearre mei it kommando "/opt/1C/v8.3/x86_64/ras cluster —daemon")).

Om dit te dwaan, klikje op de "+" knop en yn it finster dat iepent, fier it serveradres en poarte yn:

In GUI skriuwe foar 1C RAC, of ​​wer oer Tcl / Tk

Nei ôfrin sil ús server yn 'e beam ferskine troch derop te klikken, in list mei klusters sil iepenje of in ferbiningsflater wurdt werjûn.

2. Troch te klikken op de klusternamme sil in list mei funksjes dy't dêrfoar beskikber binne iepenje.

3…

En sa fierder, d.w.s. om in nij kluster ta te foegjen, selektearje ien beskikber yn 'e list en druk op de "+" knop yn 'e arkbalke en it dialoochfinster tafoegje sil werjûn wurde:

In GUI skriuwe foar 1C RAC, of ​​wer oer Tcl / Tk

De knoppen yn de arkbalke fiere funksjes ôfhinklik fan de kontekst, d.w.s. Ofhinklik fan hokker elemint fan 'e beam of list selektearre is, sil ien of oare proseduere útfierd wurde.

Litte wy nei it foarbyld sjen fan 'e knop tafoegje ("+"):

Knop generaasje koade:

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

Hjir sjogge wy dat as de knop wurdt yndrukt, de proseduere "Tafoegje" sil wurde útfierd, syn koade:

proc Add {} {
    global active_cluster host
    # Определяем идентификатор выделенного элемента
    set id  [.frm_tree.tree selection] 
    # Определяем значение этого элемента
    set values [.frm_tree.tree item [.frm_tree.tree selection] -values]
    set key [lindex [split $id "::"] 0]
    # в зависимости от того что выделили будет запущена нужная процедура
    if {$key eq "" || $key eq "server"} {
        set host [ Add::server ]
        return
    }
    Add::$key .frm_tree.tree $host $values
}

Hjir is ien fan 'e foardielen fan tickle: jo kinne de wearde fan in fariabele trochjaan as proseduerenamme:

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

Dat is, bygelyks, as wy nei de haadtsjinner wize en op "+" drukke, dan sil de Add::serverproseduere lansearre wurde, as by it kluster - Add::cluster ensafuorthinne (ik sil skriuwe oer wêr't de needsaaklike "kaaien" komme út in bytsje hjirûnder), de neamde prosedueres tekenje grafyske eleminten passend foar de kontekst.

Lykas jo miskien al opmurken hawwe, binne de foarmen ferlykber yn styl - dit is net ferrassend, om't se wurde werjûn troch ien proseduere, krekter it haadframe fan it formulier (finster, knoppen, ôfbylding, label), de namme fan 'e proseduere AddTopLevel

proc AddToplevel {lbl img {win_name .add}} {
    set cmd "destroy $win_name"
    if [winfo exists $win_name] {destroy $win_name}
    toplevel $win_name
    wm title $win_name $lbl
    wm iconphoto $win_name tcl
    # метка с иконкой
    ttk::label $win_name.lbl -image $img
    # фрейм с полями ввода
    set frm [ttk::labelframe $win_name.frm -text $lbl -labelanchor nw]
    
    grid columnconfigure $frm 0 -weight 1
    grid rowconfigure $frm 0 -weight 1
    # фрейм и кнопки
    set frm_btn [frame $win_name.frm_btn -border 0]
    ttk::button $frm_btn.btn_ok -image ok_grey_24 -command { }
    ttk::button $frm_btn.btn_cancel -command $cmd -image quit_grey_24 
    grid $win_name.lbl -row 0 -column 0 -sticky nw -padx 5 -pady 10
    grid $frm -row 0 -column 1 -sticky nw -padx 5 -pady 5
    grid $frm_btn -row 1 -column 1 -sticky se -padx 5 -pady 5
    pack  $frm_btn.btn_cancel  -side right
    pack  $frm_btn.btn_ok  -side right -padx 10
    return $frm
}

Call parameters: titel, ôfbylding namme foar it byldkaike út de bibleteek (lib/images.tcl) en in opsjoneel finster namme parameter (standert .add). Dus, as wy de boppesteande foarbylden nimme foar it tafoegjen fan de haadtsjinner en kluster, sil de oprop dienlik wêze:

AddToplevel "Добавление основного сервера" server_grey_64

of

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

No, trochgean mei dizze foarbylden, sil ik de prosedueres sjen litte dy't dialoochfinsters werjaan foar in server as kluster.

Add :: tsjinner

proc Add::server {} {
    global default
    # выводим основную форму
    set frm [AddToplevel "Добавление основного сервера" server_grey_64]
    # добавляем етки и поля ввода на эту форму
    label $frm.lbl_host -text "Адрес сервера"
    entry  $frm.ent_host
    label $frm.lbl_port -text "Порт"
    entry $frm.ent_port 
    $frm.ent_port  insert end $default(port)
    grid $frm.lbl_host -row 0 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_host -row 0 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_port -row 1 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_port -row 1 -column 1 -sticky nsew -padx 5 -pady 5
    grid columnconfigure $frm 0 -weight 1
    grid rowconfigure $frm 0 -weight 1
    #set frm_btn [frame .add.frm_btn -border 0]
    # переопределяем обработчик нажатия кнопки
    .add.frm_btn.btn_ok configure -command {
        set host [SaveMainServer [.add.frm.ent_host get] [.add.frm.ent_port get]]
        .frm_tree.tree insert {} end -id "server::$host" -text "$host" -values "$host"
        destroy .add
        return $host
    }
    return $frm
}

Add :: kluster

proc Add::cluster {tree host values} {
    global default lifetime_limit expiration_timeout session_fault_tolerance_level
    global max_memory_size max_memory_time_limit errors_count_threshold security_level
    global load_balancing_mode kill_problem_processes 
    agent_user agent_pwd cluster_user cluster_pwd auth_agent
    if {$agent_user ne "" && $agent_pwd ne ""} {
        set auth_agent "--agent-user=$agent_user --agent-pwd=$agent_pwd"
    } else {
        set auth_agent ""
    }
    # устанавливаем глобальные переменные ()
    set lifetime_limit $default(lifetime_limit)
    set expiration_timeout $default(expiration_timeout)
    set session_fault_tolerance_level $default(session_fault_tolerance_level)
    set max_memory_size $default(max_memory_size)
    set max_memory_time_limit $default(max_memory_time_limit)
    set errors_count_threshold $default(errors_count_threshold)
    set security_level [lindex $default(security_level) 0]
    set load_balancing_mode [lindex $default(load_balancing_mode) 0]
    
    set frm [AddToplevel "Добавление кластера" cluster_grey_64]
    
    label $frm.lbl_host -text "Адрес основного сервера"
    entry  $frm.ent_host
    label $frm.lbl_port -text "Порт"
    entry $frm.ent_port 
    $frm.ent_port  insert end $default(port)
    label $frm.lbl_name -text "Название кластера"
    entry  $frm.ent_name
    label $frm.lbl_secure_connect -text "Защищённое соединение"
    ttk::combobox $frm.cb_security_level -textvariable security_level -values $default(security_level)
    label $frm.lbl_expiration_timeout -text "Останавливать выключенные процессы через:"
    entry  $frm.ent_expiration_timeout -textvariable expiration_timeout
    label $frm.lbl_session_fault_tolerance_level -text "Уровень отказоустойчивости"
    entry  $frm.ent_session_fault_tolerance_level -textvariable session_fault_tolerance_level
    label $frm.lbl_load_balancing_mode -text "Режим распределения нагрузки"
    ttk::combobox $frm.cb_load_balancing_mode -textvariable load_balancing_mode 
    -values $default(load_balancing_mode)
    label $frm.lbl_errors_count_threshold -text "Допустимое отклонение количества ошибок сервера, %"
    entry  $frm.ent_errors_count_threshold -textvariable errors_count_threshold
    label $frm.lbl_processes -text "Рабочие процессы:"
    label $frm.lbl_lifetime_limit -text "Период перезапуска, сек."
    entry  $frm.ent_lifetime_limit -textvariable lifetime_limit
    label $frm.lbl_max_memory_size -text "Допустимый объём памяти, КБ"
    entry  $frm.ent_max_memory_size -textvariable max_memory_size
    label $frm.lbl_max_memory_time_limit -text "Интервал превышения допустимого объёма памяти, сек."
    entry  $frm.ent_max_memory_time_limit -textvariable max_memory_time_limit
    label $frm.lbl_kill_problem_processes -justify left -anchor nw -text "Принудительно завершать проблемные процессы"
    checkbutton $frm.check_kill_problem_processes -variable kill_problem_processes -onvalue yes -offvalue no    
    
    grid $frm.lbl_host -row 0 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_host -row 0 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_port -row 1 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_port -row 1 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_name -row 2 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_name -row 2 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_secure_connect -row 3 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.cb_security_level -row 3 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_expiration_timeout -row 4 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_expiration_timeout -row 4 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_session_fault_tolerance_level -row 5 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_session_fault_tolerance_level -row 5 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_load_balancing_mode -row 6 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.cb_load_balancing_mode -row 6 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_errors_count_threshold -row 7 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_errors_count_threshold -row 7 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_processes -row 8 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.lbl_lifetime_limit -row 9 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_lifetime_limit -row 9 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_max_memory_size -row 10 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_max_memory_size -row 10 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_max_memory_time_limit -row 11 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.ent_max_memory_time_limit -row 11 -column 1 -sticky nsew -padx 5 -pady 5
    grid $frm.lbl_kill_problem_processes -row 12 -column 0 -sticky nw -padx 5 -pady 5
    grid $frm.check_kill_problem_processes -row 12 -column 1 -sticky nw -padx 5 -pady 5
    # переопределяем обработчик
    .add.frm_btn.btn_ok configure -command {
        RunCommand "" "cluster insert 
        --host=[.add.frm.ent_host get] 
        --port=[.add.frm.ent_port get] 
        --name=[.add.frm.ent_name get] 
        --expiration-timeout=$expiration_timeout 
        --lifetime-limit=$lifetime_limit 
        --max-memory-size=$max_memory_size 
        --max-memory-time-limit=$max_memory_time_limit 
        --security-level=$security_level 
        --session-fault-tolerance-level=$session_fault_tolerance_level 
        --load-balancing-mode=$load_balancing_mode 
        --errors-count-threshold=$errors_count_threshold 
        --kill-problem-processes=$kill_problem_processes 
        $auth_agent $host"
        Run::server $tree $host ""
        destroy .add
    }
    return $frm
}

By it fergelykjen fan de koade fan dizze prosedueres is it ferskil sichtber mei it bleate each; Ik sil rjochtsje op de "Ok" knop handler. Yn Tk kinne de eigenskippen fan grafyske eleminten oerskreaun wurde tidens programma-útfiering mei de opsje Konfigurearret. Bygelyks, it earste kommando om de knop wer te jaan:

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

Mar yn ús formulieren hinget it kommando ôf fan 'e fereaske funksjonaliteit:

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

Yn it foarbyld hjirboppe begjint de "ferstoppe" knop de proseduere foar it tafoegjen fan in kluster.

Hjir is it de muoite wurdich om in ôfwiking te meitsjen nei it wurkjen mei grafyske eleminten yn Tk - foar ferskate gegevensynfiereleminten (ynfier, kombinaasjefak, kontrôleknop, ensfh.) is in parameter ynfierd as tekstfariabele:

entry  $frm.ent_lifetime_limit -textvariable lifetime_limit

Dizze fariabele is definiearre yn 'e globale nammeromte en befettet de op it stuit ynfierde wearde. Dy. om de ynfierde tekst út it fjild te krijen, moatte jo gewoan de wearde lêze dy't oerienkomt mei de fariabele (fansels, op betingst dat it wurdt definieare by it meitsjen fan it elemint).

De twadde metoade foar it opheljen fan de ynfierde tekst (foar eleminten fan yngongstype) is it kommando get te brûken:

.add.frm.ent_name get

Beide fan dizze metoaden kinne sjoen wurde yn de boppesteande koade.

Klikje op dizze knop, yn dit gefal, start de RunCommand-proseduere mei de generearre kommandorigel foar it tafoegjen fan in kluster yn termen fan 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

No komme wy by it haadkommando, dat de lansearring fan rac kontrolearret mei de parameters dy't wy nedich binne, ek de útfier fan kommando's yn listen parseart en weromkomt, as nedich:

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

Nei it ynfieren fan 'e haadtsjinnergegevens sil it wurde tafoege oan' e beam, hjirfoar, yn 'e boppesteande Add:server-proseduere, is de folgjende koade ferantwurdlik:

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

No, troch te klikken op de servernamme yn 'e beam, krije wy in list mei klusters dy't troch dy server beheard wurde, en troch te klikken op in kluster krije wy in list mei klustereleminten (servers, infobases, ensfh.). Dit wurdt ymplementearre yn de TreePress-proseduere (bestân 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
}

Dêrnjonken sil Run :: tsjinner lansearre wurde foar de haadtsjinner (foar in kluster - Run :: kluster, foar in wurkjende tsjinner - Run :: work_server, ensfh.). Dy. de wearde fan de $kaaifariabele is diel fan de namme fan it beamelemint oantsjutte troch de opsje -id.

Litte wy omtinken jaan oan de proseduere

Run :: tsjinner

proc Run::server {tree host values} {
    # получаем список кластеров требуемого сервера
    set lst [RunCommand server::$host "cluster list $host"]
    if {$lst eq ""} {return}
    set l [lindex $lst 0]
    #puts $lst
    # удаляем лишнее из списка
    .frm_work.tree_work delete  [ .frm_work.tree_work children {}]
    # читаем список
    foreach cluster_list $lst {
        # Заполняем список полученными значениями
        InsertItemsWorkList $cluster_list
        # обрабатываем вывод (список) для добавления данных в дерево
        foreach i $cluster_list {
            #puts $i
            set cluster_list [split $i ":"]
            if  {[string trim [lindex $cluster_list 0]] eq "cluster"} {
                set cluster_id [string trim [lindex $cluster_list 1]]
                lappend cluster($cluster_id) $cluster_id
            }
            if  {[string trim [lindex $cluster_list 0]] eq "name"} {
                lappend  cluster($cluster_id) [string trim [lindex $cluster_list 1]]
            }
        }
    }
    # добавляем кластеры в дерево
    foreach x [array names cluster] {
        set id [lindex $cluster($x) 0]
        if { [$tree exists "cluster::$id"] == 0 } {
            $tree insert "server::$host" end -id "cluster::$id" -text "[lindex $cluster($x) 1]" -values "$id"
            # добавляем элементы в кластер
            InsertClusterItems $tree $id
        }
    }
    if { [$tree exists "agent_admins::$id"] == 0 } {
        $tree insert "server::$host" end -id "agent_admins::$id" -text "Администраторы" -values "$id"
        #InsertClusterItems $tree $id
    }
}

Dizze proseduere ferwurket wat fan 'e tsjinner ûntfongen is fia it RunCommand kommando en foeget alle soarten dingen ta oan 'e beam - klusters, ferskate root-eleminten (bases, wurkjende servers, sesjes, ensfh.). As jo ​​goed sjogge, sille jo in oprop fernimme nei de InsertItemsWorkList-proseduere binnen. It wurdt brûkt om eleminten ta te foegjen oan in grafyske list troch it ferwurkjen fan de útfier fan it rac-konsole-helpprogramma, dat earder as list weromjûn waard nei de $lst fariabele. Dit is in list mei listen mei pearen fan eleminten skieden troch in kolon.

Bygelyks, in list mei klusterferbiningen:

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

Yn grafyske foarm sil it der sa útsjen:

In GUI skriuwe foar 1C RAC, of ​​wer oer Tcl / Tk

De boppesteande proseduere selekteart de nammen fan eleminten foar de koptekst en gegevens om de tabel yn te foljen:

InsertItemsWorkList

proc InsertItemsWorkList {lst} {
    global work_list_row_count
    # установка чередования цвета для строки
    if [expr $work_list_row_count % 2] {
        set tag dark
    } else {
        set tag light
    }
    # разбор строк на пары ключ - значение
    foreach i $lst {
        if [regexp -nocase -all -- {(D+)(s*?|)(:)(s*?|)(.*)} $i match param v2 v3 v4 value] {
            lappend column_list [string trim $param]
            lappend value_list [string trim $value]
        }
    }
     # заполнение таблицы
    .frm_work.tree_work configure -columns $column_list -displaycolumns $column_list
    .frm_work.tree_work insert {} end  -values $value_list -tags $tag
    .frm_work.tree_work column #0 -stretch
    # установка заголовков
    foreach j $column_list {
        .frm_work.tree_work heading $j -text $j
    }
    incr work_list_row_count
}

Hjir, ynstee fan in ienfâldich kommando [split $str ":"], dat de tekenrige splitst yn eleminten skieden troch ":" en in list werombringt, wurdt in reguliere útdrukking brûkt, om't guon eleminten ek in kolon befetsje.

De proseduere InsertClusterItems (ien fan ferskate ferlykbere) foeget gewoan in list ta mei berneleminten mei oerienkommende identifiers ta oan de beam fan it fereaske klusterelemint
InsertClusterItems

proc InsertClusterItems {tree id} {
    set parent "cluster::$id"
    $tree insert $parent end -id "infobases::$id" -text "Информационные базы" -values "$id"
    $tree insert $parent end -id "servers::$id" -text "Рабочие серверы" -values "$id"
    $tree insert $parent end -id "admins::$id" -text "Администраторы" -values "$id"
    $tree insert $parent end -id "managers::$id" -text "Менеджеры кластера" -values $id
    $tree insert $parent end -id "processes::$id" -text "Рабочие процессы" -values "workprocess-all"
    $tree insert $parent end -id "sessions::$id" -text "Сеансы" -values "sessions-all"
    $tree insert $parent end -id "locks::$id" -text "Блокировки" -values "blocks-all"
    $tree insert $parent end -id "connections::$id" -text "Соединения" -values "connections-all"
    $tree insert $parent end -id "profiles::$id" -text "Профили безопасности" -values $id
}

Jo kinne noch twa opsjes beskôgje foar it útfieren fan in ferlykbere proseduere, wêr't it dúdlik sichtber is hoe't jo repetitive kommando's kinne optimalisearje en kwytreitsje:

Yn dizze proseduere wurdt it tafoegjen en kontrolearjen direkt oplost:

InsertBaseItems

proc InsertBaseItems {tree id} {
    set parent "infobase::$id"
    if { [$tree exists "sessions::$id"] == 0 } {
        $tree insert $parent end -id "sessions::$id" -text "Сеансы" -values "$id"
    }
    if { [$tree exists "locks::$id"] == 0 } {
        $tree insert $parent end -id "locks::$id" -text "Блокировки" -values "$id"
    }
    if { [$tree exists "connections::$id"] == 0 } {
        $tree insert $parent end -id "connections::$id" -text "Соединения" -values "$id"
    }
}

Hjir is in mear korrekte oanpak:

InsertProfileItems

proc InsertProfileItems {tree id} {
    set parent "profile::$id"
    set lst {
        {dir "Виртуальные каталоги"}
        {com "Разрешённые COM-классы"}
        {addin "Внешние компоненты"}
        {module "Внешние отчёты и обработки"}
        {app "Разрешённые приложения"}
        {inet "Ресурсы интернет"}
    }
    foreach i $lst {
        append item [lindex $i 0] "::$id"
        if { [$tree exists $item] == 0 } {
            $tree insert $parent end -id $item -text [lindex $i 1] -values "$id"
        }
        unset item 
    }
}

It ferskil tusken harren is it brûken fan in loop, wêryn de werhelle kommando(s) wurde útfierd. Hokker oanpak om te brûken is nei it goedtinken fan de ûntwikkelder.

Wy hawwe it tafoegjen fan eleminten en it opheljen fan gegevens behannele, no is it tiid om te fokusjen op bewurkjen. Sûnt, yn prinsipe, deselde parameters wurde brûkt foar it bewurkjen en tafoegjen (mei útsûndering fan 'e ynformaasjebasis), wurde deselde dialoochfoarmen brûkt. It algoritme foar it oproppen fan prosedueres foar tafoegjen sjocht der sa út:

Add::$key->AddToplevel

En foar sa bewurkjen:

Bewurkje::$key->Add::$key->AddTopLevel

Litte wy bygelyks it bewurkjen fan in kluster nimme, d.w.s. Klikje op de namme fan it kluster yn 'e beam, druk op de bewurkje knop yn' e arkbalke (potlead) en it oerienkommende formulier sil op it skerm werjûn wurde:

In GUI skriuwe foar 1C RAC, of ​​wer oer Tcl / Tk
Bewurkje :: kluster

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

Op grûn fan 'e opmerkings yn' e koade is yn prinsipe alles dúdlik, útsein dat de knopbehearderkoade wurdt oerskreaun en d'r is in FormFieldsDataInsert-proseduere dy't de fjilden foltôget mei gegevens en de fariabelen inisjalisearret:

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

Yn dizze proseduere kaam in oar foardiel fan tcl boppe - de wearden fan oare fariabelen wurde ferfongen as fariabelenammen. Dy. om it ynfoljen fan formulieren en inisjalisaasje fan fariabelen te automatisearjen, komme de nammen fan fjilden en fariabelen oerien mei de kommandorigelskeakels fan it rac-nutsbedriuw en de nammen fan kommando-útfierparameters mei wat útsûndering - it streepke wurdt ferfongen troch in ûnderstreekje. Bv plande-jobs-weinsjen komt oerien mei it fjild ent_scheduled_jobs_deny en fariabele pland_jobs_weigerje.

Formulieren foar it tafoegjen en bewurkjen kinne ferskille yn 'e gearstalling fan' e fjilden, bygelyks wurkjen mei in ynformaasjebasis:

It tafoegjen fan ynformaasjefeiligens

In GUI skriuwe foar 1C RAC, of ​​wer oer Tcl / Tk

Bewurkje ynformaasje feiligens

In GUI skriuwe foar 1C RAC, of ​​wer oer Tcl / Tk

Yn de bewurkingsproseduere Edit::infobase wurde de fereaske fjilden tafoege oan it formulier; de koade is voluminous, dêrom presintearje ik it hjir net.

Troch analogy wurde prosedueres foar tafoegjen, bewurkjen, wiskjen ymplementearre foar oare eleminten.

Sûnt de wurking fan it hulpprogramma in ûnbeheind oantal servers, klusters, ynformaasjebases, ensfh. tiid jo klikke op de eleminten fan 'e beam. Dy. de proseduere rint rekursyf troch alle âldere eleminten en stelt de fariabelen yn:

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

It 1C-kluster lit jo wurkje mei of sûnder autorisaasje. D'r binne twa soarten behearders - klusteragentbehearder en klusterbehearder. Dêrtroch, foar juste operaasje, waarden 4 mear globale fariabelen yntrodusearre mei de behearder login en wachtwurd. Dy. as der in behearder akkount is yn it kluster, sil in dialooch werjûn wurde om jo oanmelding en wachtwurd yn te fieren, de gegevens wurde bewarre yn it ûnthâld en ynfoege yn elk kommando foar it oerienkommende kluster.

Dit is de ferantwurdlikens fan de flater ôfhanneling proseduere.

ErrorParcing

proc ErrorParcing {err opt} {
    global cluster_user cluster_pwd agent_user agent_pwd
        switch -regexp -- $err {
        "Cluster administrator is not authenticated" {
            AuthorisationDialog "Администратор кластера"
            .auth_win.frm_btn.btn_ok configure -command {
                set cluster_user [.auth_win.frm.ent_name get]
                set cluster_pwd [.auth_win.frm.ent_pwd get]
                destroy .auth_win
            }
            #RunCommand $root $par
        }
        "Central server administrator is not authenticated" {
            AuthorisationDialog "Администратор агента кластера"
            .auth_win.frm_btn.btn_ok configure -command {
                set agent_user [.auth_win.frm.ent_name get]
                set agent_pwd [.auth_win.frm.ent_pwd get]
                destroy .auth_win
            }
        }
        "Администратор кластера не аутентифицирован" {
            AuthorisationDialog "Администратор кластера"
            .auth_win.frm_btn.btn_ok configure -command {
                set cluster_user [.auth_win.frm.ent_name get]
                set cluster_pwd [.auth_win.frm.ent_pwd get]
                destroy .auth_win
            }
            #RunCommand $root $par
        }
        "Администратор центрального сервера не аутентифицирован" {
            AuthorisationDialog "Администратор агента кластера"
            .auth_win.frm_btn.btn_ok configure -command {
                set agent_user [.auth_win.frm.ent_name get]
                set agent_pwd [.auth_win.frm.ent_pwd get]
                destroy .auth_win
            }
        }
        (.+) {
            tk_messageBox -type ok -icon error -message "$err"
        }
    }
}

Dy. ôfhinklik fan wat it kommando werombringt, sil de reaksje dêrop wêze.

Op it stuit is sawat 95 prosint fan 'e funksjonaliteit ymplementearre, alles wat oerbliuwt is wurk mei feiligensprofilen ymplementearje en it testen =). Da's alles. Ik ferûntskuldigje my foar it ferfrommele ferhaal.

De koade is tradisjoneel beskikber hjir.

Update: Ik bin klear mei wurkjen mei befeiligingsprofilen. No is de funksjonaliteit 100% ymplementearre.

Update 2: lokalisaasje yn it Ingelsk en Russysk is tafoege, wurk yn win7 is hifke
In GUI skriuwe foar 1C RAC, of ​​wer oer Tcl / Tk

Boarne: www.habr.com

Add a comment