Schreiwen eng GUI fir 1C RAC, oder erëm iwwer Tcl / Tk

Wéi mir an d'Thema verdéift hunn wéi 1C Produkter am Linux Ëmfeld funktionnéieren, gouf een Nodeel entdeckt - de Mangel un engem praktesche grafesche Multi-Plattform Tool fir e Cluster vun 1C Serveren ze managen. An et gouf decidéiert dësen Nodeel ze korrigéieren andeems en GUI fir d'Rac Console Utility schreift. Tcl/tk gouf als Entwécklungssprooch gewielt, menger Meenung no, am meeschte gëeegent fir dës Aufgab. An dofir wëll ech e puer interessant Aspekter vun der Léisung an dësem Material presentéieren.

Fir ze schaffen braucht Dir tcl / tk an 1C Verdeelungen. A well ech decidéiert hunn déi meeschte Fäegkeeten vun der Basis tcl / tk Liwwerung ze maachen ouni Drëtt-Partei Packagen ze benotzen, brauch ech Versioun 8.6.7, déi ttk enthält - e Package mat zousätzlech grafeschen Elementer, vun deenen mir haaptsächlech ttk brauchen ::TreeView, et erlaabt Donnéeën ze weisen souwuel a Form vun enger Bamstruktur an a Form vun enger Tabell (Lëscht). Och an der neier Versioun ass d'Aarbecht mat Ausnahmen ëmgeschafft ginn (de Kommando probéiert, deen am Projet benotzt gëtt wann Dir extern Kommandoen leeft).

De Projet besteet aus verschiddene Dateien (obwuel näischt verhënnert datt Dir alles an engem mécht):

rac_gui.cfg - Standardkonfiguratioun
rac_gui.tcl - Haaptstartskript
De lib Verzeichnis enthält Dateien déi automatesch beim Startup geluede ginn:
function.tcl - Fichier mat Prozeduren
gui.tcl - Haapt grafesch Interface
images.tcl - base64 Bildbibliothéik

D'rac_gui.tcl-Datei fänkt tatsächlech den Dolmetscher un, initialiséiert Variabelen, lued Moduler, Konfiguratiounen, asw. Inhalt vum Fichier mat Kommentaren:

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

Nodeems Dir alles erofgelueden hutt wat erfuerderlech ass a kontrolléiert op d'Präsenz vum Rac Utility, gëtt eng grafesch Fënster gestart. De Programminterface besteet aus dräi Elementer:

Toolbar, Bam a Lëscht

Ech hunn den Inhalt vum "Bam" sou ähnlech wéi méiglech mat der Standard Windows Ausrüstung vun 1C gemaach.

Schreiwen eng GUI fir 1C RAC, oder erëm iwwer Tcl / Tk

Den Haaptcode deen dës Fënster formt ass an der Datei enthale
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

Den Algorithmus fir mam Programm ze schaffen ass wéi follegt:

1. Als éischt musst Dir den Haaptclusterserver addéieren (dh de Cluster Management Server (am Linux gëtt d'Gestioun mam Kommando "/opt/1C/v8.3/x86_64/ras Cluster —daemon") lancéiert).

Fir dëst ze maachen, klickt op de "+" Knäppchen an an der Fënster déi opmaacht, gitt d'Serveradress an den Hafen:

Schreiwen eng GUI fir 1C RAC, oder erëm iwwer Tcl / Tk

Duerno erschéngt eise Server am Bam andeems Dir drop klickt, eng Lëscht vu Cluster gëtt op oder e Verbindungsfehler gëtt ugewisen.

2. Klickt op de Clusternumm wäert eng Lëscht vu Funktiounen opmaachen, déi dofir verfügbar sinn.

3...

An esou weider, d.h. fir en neie Stärekoup derbäizefügen, wielt iergendeen verfügbar an der Lëscht an dréckt op de "+" Knäppchen an der Toolbar an den Dialog nei addéieren gëtt ugewisen:

Schreiwen eng GUI fir 1C RAC, oder erëm iwwer Tcl / Tk

D'Knäppercher an der Toolbar maachen Funktiounen ofhängeg vum Kontext, d.h. Ofhängeg vun deem Element vum Bam oder der Lëscht ausgewielt gëtt, gëtt eng oder aner Prozedur gemaach.

Loosst eis d'Beispill vum Add Button ("+") kucken:

Knäppchen Generatioun Code:

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

Hei gesi mir datt wann de Knäppchen gedréckt gëtt, gëtt d'Prozedur "Add" ausgefouert, säi Code:

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
}

Hei ass ee vun de Virdeeler vum Tickle: Dir kënnt de Wäert vun enger Variabel als Prozedurnumm passéieren:

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

Dat ass, zum Beispill, wa mir op den Haaptserver weisen an "+" drécken, da gëtt d'Add::Server Prozedur lancéiert, wann um Cluster - Add :: Cluster an sou weider (ech schreiwen iwwer wou de Cluster néideg "Schlësselen" kommen aus an e bëssen ënnert), déi opgezielt Prozeduren molen grafesch Elementer passend fir de Kontext.

Wéi Dir vläicht scho gemierkt hutt, sinn d'Formen ähnlech am Stil - dat ass net iwwerraschend, well se vun enger Prozedur ugewisen ginn, méi präzis den Haaptframe vun der Form (Fënster, Knäpper, Bild, Label), den Numm vun der Prozedur. 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 Parameteren: Titel, Bild Numm fir d'Ikon aus der Bibliothéik (lib/images.tcl) an eng fakultativ Fënster Numm Parameter (Standard .add). Also, wa mir déi uewe genannte Beispiller huelen fir den Haaptserver a Cluster derbäi ze ginn, wäert den Uruff deementspriechend sinn:

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

oder

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

Gutt, weider mat dëse Beispiller, wäert ech d'Prozeduren weisen, déi Dialoge fir e Server oder Cluster addéieren.

Dobäi :: Server

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

Dobäi :: Stärekoup

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
}

Wann Dir de Code vun dëse Prozeduren vergläicht, ass den Ënnerscheed mat bloussem A siichtbar; Ech konzentréieren mech op den "Ok" Knäppchen Handler. Am Tk kënnen d'Eegeschafte vu grafeschen Elementer während der Ausféierung vum Programm iwwerschratt ginn mat der Optioun konfiguréieren. Zum Beispill, den initialen Kommando fir de Knäppchen ze weisen:

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

Awer an eise Formen hänkt de Kommando vun der erfuerderter Funktionalitéit of:

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

Am Beispill hei uewen fänkt de "verstoppt" Knäppchen d'Prozedur un fir e Stärekoup ze addéieren.

Hei ass et derwäert eng Digression ze maachen fir mat grafeschen Elementer am Tk ze schaffen - fir verschidden Dateinputelementer (Entrée, Combobox, Checkbutton, etc.) gouf e Parameter als Textvariabel agefouert:

entry  $frm.ent_lifetime_limit -textvariable lifetime_limit

Dës Variabel ass am globalen Nummraum definéiert an enthält den aktuell aginnen Wäert. Déi. Fir den aginnen Text aus dem Feld ze kréien, musst Dir just de Wäert liesen, deen der Variabel entsprécht (natierlech, virausgesat datt et definéiert gëtt beim Schafe vum Element).

Déi zweet Method fir den aginnen Text z'erhalen (fir Elementer vum Entréestyp) ass de get Kommando ze benotzen:

.add.frm.ent_name get

Béid vun dëse Methoden kënnen am uewe genannte Code gesi ginn.

Klickt op dëse Knäppchen, an dësem Fall, lancéiert d'RunCommand Prozedur mat der generéierter Kommandozeil fir e Cluster a punkto rac ze addéieren:

/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

Elo komme mir zum Haaptbefehl, deen de Start vu rac kontrolléiert mat de Parameteren déi mir brauchen, parséiert och d'Output vun de Kommandoen an d'Lëschten a gëtt zréck, wann néideg:

Run Kommando

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

Nodeems Dir d'Haaptserverdaten aginn hutt, ginn se an de Bam bäigefüügt, dofir, an der uewen Add: Server Prozedur, ass de folgende Code verantwortlech:

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

Elo, andeems Dir op de Servernumm am Bam klickt, kréie mir eng Lëscht vu Cluster, déi vun deem Server geréiert ginn, a andeems Dir op e Cluster klickt, kréie mir eng Lëscht vu Clusterelementer (Server, Infobasen, etc.). Dëst gëtt an der TreePress Prozedur implementéiert (Datei 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
}

Deementspriechend gëtt Run :: Server fir den Haaptserver lancéiert (fir e Stärekoup - Run :: Stärekoup, fir e schaffende Server - Run :: work_server, etc.). Déi. de Wäert vun der $Schlëssel Variabel ass en Deel vum Numm vum Bamelement, deen duerch d'Optioun uginn ass -id.

Loosst eis op d'Prozedur oppassen

Run :: Server

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

Dës Prozedur veraarbecht wat vum Server duerch de RunCommand Kommando kritt gouf a füügt all Zorte vu Saachen un de Bam - Cluster, verschidde Root Elementer (Basen, Aarbechtsserver, Sessiounen, asw.). Wann Dir genau kuckt, mierkt Dir en Uruff un d'InsertItemsWorkList Prozedur bannen. Et gëtt benotzt fir Elementer op eng grafesch Lëscht ze addéieren andeems d'Output vum Rac Console Utility veraarbecht gëtt, wat virdru als Lëscht an d'$lst Variabel zréckkoum. Dëst ass eng Lëscht vu Lëschte mat Pairen vun Elementer, getrennt vun engem Colon.

Zum Beispill, eng Lëscht vu Clusterverbindungen:

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

A grafescher Form wäert et sou ausgesinn:

Schreiwen eng GUI fir 1C RAC, oder erëm iwwer Tcl / Tk

Déi uewe genannte Prozedur wielt d'Nimm vun Elementer fir den Header an d'Donnéeën fir den Dësch auszefëllen:

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
}

Amplaz vun engem einfachen Kommando [split $str ":"], deen d'String an Elementer opdeelt, getrennt vun ":" an eng Lëscht zréckginn, gëtt e regulären Ausdrock benotzt, well verschidden Elementer och e Colon enthalen.

D'InsertClusterItems Prozedur (ee vun e puer ähnlechen) füügt einfach eng Lëscht vun Kannerelementer mat entspriechenden Identifizéierer un de Bam vum erfuerderleche Clusterelement derbäi
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
}

Dir kënnt zwou weider Optiounen betruechten fir eng ähnlech Prozedur ëmzesetzen, wou et kloer sichtbar ass wéi Dir repetitive Kommandoen optiméiere kënnt an entlooss gëtt:

An dëser Prozedur ginn d'Addéieren an d'Kontroll direkt geléist:

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

Hei ass eng méi korrekt Approche:

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

Den Ënnerscheed tëscht hinnen ass d'Benotzung vun enger Loop, an där déi widderholl Kommando(en) ausgefouert ginn. Wéi eng Approche ze benotzen ass um Diskretioun vum Entwéckler.

Mir hunn Elementer bäigefüügt an Daten zréckgezunn, elo ass et Zäit op d'Editioun ze fokusséieren. Well am Fong déiselwecht Parameter fir d'Editioun an d'Additioun benotzt ginn (mat Ausnam vun der Informatiounsbasis), ginn déiselwecht Dialogforme benotzt. Den Algorithmus fir Uruffprozeduren fir d'Addéieren ze ruffen gesäit esou aus:

Add::$key->AddToplevel

A fir esou ze änneren:

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

Loosst eis zum Beispill e Cluster änneren, d.h. Nodeems Dir op den Numm vum Stärekoup am Bam geklickt hutt, dréckt op den Edit Knäppchen an der Toolbar (Bleistift) an déi entspriechend Form gëtt um Bildschierm ugewisen:

Schreiwen eng GUI fir 1C RAC, oder erëm iwwer 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
    }
}

Baséierend op de Kommentaren am Code, am Prinzip, ass alles kloer, ausser datt de Knäppchen Handler Code iwwerschriwwe gëtt an et gëtt eng FormFieldsDataInsert Prozedur déi d'Felder mat Daten ausfëllt an d'Variabelen initialiséiert:

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

An dëser Prozedur ass en anere Virdeel vun tcl opgedaucht - d'Wäerter vun anere Variablen ginn als Variabel Nimm ersat. Déi. fir d'Fëllung vu Formulairen an d'Initialiséierung vu Variablen ze automatiséieren, entspriechen d'Nimm vu Felder a Variabelen de Kommandozeilschalter vum rac Utility an d'Nimm vun de Kommandoausgangsparameter mat e puer Ausnahmen - den Bindestrich gëtt duerch en Ënnersträich ersat. zB geplangt-Aarbechtsplazen-verleegnen entsprécht dem Terrain ent_scheduled_jobs_deny an variabel geplangt_jobs_weigeren.

Forme fir d'Addéieren an d'Ännerung kënnen an der Zesummesetzung vun de Felder ënnerscheeden, zum Beispill, mat enger Informatiounsbasis ze schaffen:

Dobäizemaachen Informatiounssécherheet

Schreiwen eng GUI fir 1C RAC, oder erëm iwwer Tcl / Tk

Informatiounssécherheet änneren

Schreiwen eng GUI fir 1C RAC, oder erëm iwwer Tcl / Tk

An der Redaktiounsprozedur Edit::infobase ginn déi erfuerderlech Felder an d'Form bäigefüügt; de Code ass voluminös, dofir presentéieren ech en net hei.

An Analogie gi Prozedure fir d'Addéieren, d'Editioun, d'Läschen fir aner Elementer ëmgesat.

Zënter der Operatioun vum Utility implizéiert eng onlimitéiert Zuel vu Serveren, Cluster, Informatiounsbasen, asw., fir ze bestëmmen, wéi ee Stärekoup zu deem Server oder Informatiounssécherheetssystem gehéiert, goufen e puer global Variablen agefouert, d'Wäerter vun deenen all gesat ginn. Zäit Dir op d'Elementer vum Bam klickt. Déi. d'Prozedur leeft rekursiv duerch all Elterendeel a setzt d'Variabelen:

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

Den 1C Cluster erlaabt Iech mat oder ouni Autorisatioun ze schaffen. Et ginn zwou Aarte vun Administrateuren - Cluster Agent Administrator a Cluster Administrator. Deementspriechend, fir eng korrekt Operatioun, goufen 4 méi global Variablen agefouert, déi den Administrator Login a Passwuert enthalen. Déi. wann et en Administrator Kont am Stärekoup gëtt, gëtt en Dialog ugewisen fir Äre Login a Passwuert anzeginn, d'Donnéeë ginn an der Erënnerung gespäichert an an all Kommando fir de entspriechende Stärekoup agebaut.

Dëst ass d'Verantwortung vun der Fehlerhandlungsprozedur.

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

Déi. jee no wat de Kommando zréckkënnt, wäert d'Reaktioun deementspriechend sinn.

Am Moment sinn ongeféier 95 Prozent vun der Funktionalitéit ëmgesat ginn, alles wat bleift ass d'Aarbecht mat Sécherheetsprofiler ëmzesetzen an ze testen =). Dat ass alles. Ech entschëllege mech fir déi gekrabbelt Geschicht.

De Code ass traditionell verfügbar hei.

Update: Ech hunn fäerdeg mat Sécherheetsprofile geschafft. Elo ass d'Funktionalitéit 100% ëmgesat.

Update 2: Lokalisatioun op Englesch a Russesch ass bäigefüügt, Aarbecht am win7 gouf getest
Schreiwen eng GUI fir 1C RAC, oder erëm iwwer Tcl / Tk

Source: will.com

Setzt e Commentaire