1C RAC үчүн GUI жазуу, же кайра Tcl/Tk жөнүндө

Linux чөйрөсүндө 1C өнүмдөрү кандайча иштээри жөнүндө теманы изилдеп чыкканыбызда, бир кемчилик табылды - 1С серверлеринин кластерин башкаруу үчүн ыңгайлуу графикалык көп платформалуу куралдын жоктугу. Жана бул кемчиликти rac консолунун утилитасы үчүн GUI жазуу менен оңдоо чечими кабыл алынды. Tcl/tk өнүктүрүү тили катары, менин оюмча, бул милдет үчүн эң ылайыктуу тил катары тандалган. Ошентип, мен бул материалда чечүүнүн кээ бир кызыктуу аспектилерин сунуш кылгым келет.

Иштөө үчүн сизге tcl/tk жана 1C бөлүштүрүү керек болот. Мен үчүнчү тараптын пакеттерин колдонбостон негизги tcl/tk жеткирүү мүмкүнчүлүктөрүн максималдуу түрдө колдонууну чечкендиктен, мага ttk камтылган 8.6.7 версиясы керек болот - кошумча графикалык элементтери бар пакет, анын ичинде бизге негизинен ttk керек. ::TreeView, ал дарак структурасы түрүндө да, таблица (тизме) түрүндө да көрсөтүүгө мүмкүндүк берет. Ошондой эле, жаңы версияда өзгөчөлүктөр менен иштөө кайра иштелип чыккан (тышкы буйруктарды иштетүүдө долбоордо колдонулган try буйругу).

Долбоор бир нече файлдардан турат (бирок баарын бир файлда жасоого эч нерсе тоскоолдук кылбайт):

rac_gui.cfg - демейки конфигурация
rac_gui.tcl - негизги ишке киргизүү скрипти
lib каталогу ишке киргенде автоматтык түрдө жүктөлүүчү файлдарды камтыйт:
function.tcl - процедуралары бар файл
gui.tcl - негизги графикалык интерфейс
images.tcl - base64 сүрөт китепканасы

rac_gui.tcl файлы, чындыгында, котормочуну иштетет, өзгөрмөлөрдү инициализациялайт, модулдарды, конфигурацияларды ж.б.у.с. жүктөйт. Комментарийлер менен файлдын мазмуну:

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

Керектүү нерселердин бардыгын жүктөп алып, rac утилитасынын бар-жоктугун текшергенден кийин, графикалык терезе ачылат. Программанын интерфейси үч элементтен турат:

Куралдар панели, дарак жана тизме

Мен "дарактын" мазмунун 1С стандарттык Windows жабдыктарына мүмкүн болушунча окшош кылдым.

1C RAC үчүн GUI жазуу, же кайра Tcl/Tk жөнүндө

Бул терезени түзгөн негизги код файлда камтылган
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

Программа менен иштөө алгоритми төмөнкүдөй:

1. Биринчиден, сиз негизги кластер серверин (б.а. кластердик башкаруу серверин) кошушуңуз керек (Linux'та башкаруу “/opt/1C/v8.3/x86_64/ras cluster —daemon” буйругу менен ишке киргизилген)).

Бул үчүн, "+" баскычын чыкылдатып, ачылган терезеде сервердин дарегин жана портун киргизиңиз:

1C RAC үчүн GUI жазуу, же кайра Tcl/Tk жөнүндө

Андан кийин, биздин сервер аны басуу менен даракта пайда болот, кластерлердин тизмеси ачылат же байланыш катасы көрсөтүлөт.

2. Кластердин аталышын басуу, ал үчүн жеткиликтүү функциялардын тизмесин ачат.

3.…

Жана башкалар, б.а. жаңы кластер кошуу үчүн, тизмеден каалаганын тандап, куралдар панелиндеги "+" баскычын басыңыз, ошондо жаңы кошуу диалогу пайда болот:

1C RAC үчүн GUI жазуу, же кайра Tcl/Tk жөнүндө

Куралдар панелиндеги баскычтар контекстке жараша функцияларды аткарат, б.а. Дарактын же тизменин кайсы элементи тандалганына жараша тигил же бул процедура аткарылат.

"+" кошуу баскычынын мисалын карап көрөлү:

Баскыч түзүү коду:

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

Бул жерде биз баскыч басылганда, "Кошуу" процедурасы аткарыла турганын көрөбүз, анын коду:

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
}

Бул жерде кытыгылоонун артыкчылыктарынын бири: сиз өзгөрмөнүн маанисин процедура аты катары өткөрө аласыз:

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

Башкача айтканда, мисалы, негизги серверди көрсөтүп, “+” баскычын бассак, Add::server процедурасы ишке кирет, эгерде кластерде - Add::cluster ж.б. зарыл болгон "ачкычтар" бир аз ылдыйдан келет), тизмеленген процедуралар контекстке ылайыктуу графикалык элементтерди тартат.

Сиз буга чейин байкагандай, формалар стили боюнча окшош - бул таң калыштуу эмес, анткени алар бир процедура менен, тагыраагы форманын негизги кадры (терезе, баскычтар, сүрөт, этикетка), процедуранын аталышы менен көрсөтүлөт. 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
}

Чакыруу параметрлери: аталышы, китепканадагы сөлөкөт үчүн сүрөттүн аты (lib/images.tcl) жана кошумча терезе аталышы параметри (демейки .add). Ошентип, эгерде биз негизги серверди жана кластерди кошуу үчүн жогорудагы мисалдарды алсак, чалуу ошого жараша болот:

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

же

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

Ооба, бул мисалдарды улантуу менен, мен сервер же кластер үчүн кошуу диалогдорун көрсөткөн процедураларды көрсөтөм.

кошуу::сервер

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
}

кошуу::кластер

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
}

Бул процедуралардын кодун салыштырганда, айырма көзгө көрүнүп турат, мен "Ok" баскычын иштетүүчүгө басым жасайм. Tk-да графикалык элементтердин касиеттери программанын аткарылышы учурунда параметрди колдонуу менен жокко чыгарылат күүлөй. Мисалы, баскычты көрсөтүү үчүн баштапкы буйрук:

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  $frm.ent_lifetime_limit -textvariable lifetime_limit

Бул өзгөрмө глобалдык аттар мейкиндигинде аныкталган жана учурда киргизилген маанини камтыйт. Ошол. талаадан киргизилген текстти алуу үчүн, жөн гана өзгөрмө тиешелүү маанини окуу керек (албетте, элементти түзүү учурунда аныкталган шартта).

Киргизилген текстти алуунун экинчи ыкмасы (кирүү түрүнүн элементтери үчүн) алуу буйругун колдонуу:

.add.frm.ent_name get

Бул эки ыкманы тең жогорудагы коддон көрүүгө болот.

Бул баскычты басуу, бул учурда, rac жагынан кластер кошуу үчүн түзүлгөн буйрук сабы менен RunCommand процедурасын ишке киргизет:

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

Эми дарактагы сервердин атын басуу менен биз ошол сервер башкарган кластерлердин тизмесин алабыз, ал эми кластерди басуу менен кластердин элементтеринин (серверлер, инфобазалар ж.б.) тизмесин алабыз. Бул TreePress процедурасында ишке ашырылат (file 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 ж.б.). Ошол. $ ачкыч өзгөрмөнүн мааниси параметр тарабынан көрсөтүлгөн дарак элементинин аталышынын бир бөлүгү -id.

Процедурага көңүл буралы

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

Бул процедура RunCommand буйругу аркылуу серверден алынгандарды иштетет жана даракка ар кандай нерселерди - кластерлерди, ар кандай түпкү элементтерди (базалар, жумушчу серверлер, сеанстар ж.б.у.с.) кошот. Эгер жакшылап карасаңыз, ичиндеги InsertItemsWorkList процедурасына чакырууну байкайсыз. Ал мурда $lst өзгөрмөсүнө тизме катары кайтарылган rac консолунун утилитасынын чыгышын иштетүү аркылуу графикалык тизмеге элементтерди кошуу үчүн колдонулат. Бул эки чекит менен бөлүнгөн жуп элементтерди камтыган тизмелердин тизмеси.

Мисалы, кластердик байланыштардын тизмеси:

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

Графикалык түрдө ал төмөнкүдөй көрүнөт:

1C RAC үчүн GUI жазуу, же кайра Tcl/Tk жөнүндө

Жогорудагы процедура үстөлдүн элементтеринин аталышын жана таблицаны толтуруу үчүн маалыматтарды тандайт:

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
}

Бул жерде жөнөкөй буйруктун ордуна [split $str ":"], ал сапты ":" менен бөлүнгөн элементтерге бөлүп, тизмени кайтарат, регулярдуу туюнтма колдонулат, анткени кээ бир элементтерде кош чекит да бар.

InsertClusterItems процедурасы (бир нече окшоштордун бири) жөн гана керектүү кластер элементинин дарагына тиешелүү идентификаторлору бар бала элементтердин тизмесин кошот.
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
}

Окшош процедураны ишке ашыруунун дагы эки вариантын карап чыксаңыз болот, анда сиз кантип оптималдаштыруу жана кайталануучу буйруктардан арылуу мүмкүн экендиги айкын көрүнүп турат:

Бул жол-жободо, кошуу жана текшерүү бетме-бет чечилет:

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

Бул жерде дагы туура мамиле:

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

Алардын ортосундагы айырма кайталануучу команда(лар) аткарылган циклди колдонууда. Кайсы ыкманы колдонуу - иштеп чыгуучунун каалоосу.

Биз элементтерди кошуу жана маалыматтарды алуу маселелерин чечтик, эми түзөтүүгө көңүл бурууга убакыт келди. Негизинен бир эле параметрлер түзөтүү жана кошуу үчүн колдонулгандыктан (маалыматтык базаны кошпогондо), ошол эле диалог формалары колдонулат. Кошуу үчүн процедураларды чакыруу алгоритми төмөнкүдөй көрүнөт:

Add::$key->AddToplevel

Жана ушул сыяктуу түзөтүү үчүн:

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

Мисалы, кластерди түзөтүүнү алалы, б.а. Дарактагы кластердин атын чыкылдатып, куралдар панелиндеги (карандаш) түзөтүү баскычын басыңыз жана экранда тиешелүү форма пайда болот:

1C RAC үчүн GUI жазуу, же кайра 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
                }
            }
        }
    }
}

Бул процедурада tclдин дагы бир артыкчылыгы пайда болду - башка өзгөрмөлөрдүн маанилери өзгөрмө аталыштары менен алмаштырылат. Ошол. формаларды толтурууну жана өзгөрмөлөрдү инициализациялоону автоматташтыруу үчүн талаалардын жана өзгөрмөлөрдүн аттары rac утилитасынын командалык сап өчүргүчтөрүнө жана командалык чыгаруу параметрлеринин атына кээ бир өзгөчөлүктөр менен туура келет - сызыкча астынкы сызык менен алмаштырылат. Мисалга пландаштырылган жумуштарды четке кагуу талаага дал келет пландаштырылган_жумуштарды_башкаруу жана өзгөрмө пландаштырылган_жумуштарды_башкаруу.

Кошуу жана түзөтүү формалары талаалардын курамында айырмаланышы мүмкүн, мисалы, маалымат базасы менен иштөө:

Маалыматтык коопсуздукту кошуу

1C RAC үчүн GUI жазуу, же кайра Tcl/Tk жөнүндө

Маалыматтык коопсуздукту түзөтүү

1C RAC үчүн GUI жазуу, же кайра Tcl/Tk жөнүндө

Edit::infobase түзөтүү процедурасында формага талап кылынган талаалар кошулат; код көлөмдүү, ошондуктан мен аны бул жерде көрсөтпөйм.

Аналогия боюнча, башка элементтер үчүн кошуу, түзөтүү, жок кылуу процедуралары ишке ашырылат.

Утилитанын иштеши серверлердин, кластерлердин, маалымат базаларынын жана башкалардын чексиз санын камтыгандыктан, кайсы кластер кайсы серверге же маалыматтык коопсуздук тутумуна таандык экенин аныктоо үчүн бир нече глобалдык өзгөрмөлөр киргизилген, алардын маанилери ар биринде белгиленген. дарактын элементтерин басканда. Ошол. процедура рекурсивдүү түрдө бардык негизги элементтер аркылуу өтөт жана өзгөрмөлөрдү орнотот:

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

1С кластери уруксатсыз же уруксатсыз иштөөгө мүмкүндүк берет. Администраторлордун эки түрү бар — кластердик агент администратору жана кластер администратору. Демек, туура иштеши үчүн, администратордун логин жана сырсөзүн камтыган дагы 4 глобалдык өзгөрмө киргизилген. Ошол. кластерде администратордук каттоо эсеби болсо, логин менен паролду киргизүү үчүн диалог терезеси пайда болот, маалыматтар эстутумда сакталат жана тиешелүү кластердин ар бир буйругуна киргизилет.

Бул каталарды башкаруу процедурасынын жоопкерчилиги.

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

Ошол. команда кайтарган нерсеге жараша реакция ошого жараша болот.

Учурда функциянын 95 пайызга жакыны ишке ашырылды, коопсуздук профилдери менен иштөө жана аны сыноо =). Баары болду. Укмуш окуя үчүн кечирим сурайм.

Код салттуу түрдө жеткиликтүү бул жерде.

Жаңыртуу: Мен коопсуздук профилдери менен иштеп бүттүм. Азыр функция 100% ишке ашты.

Жаңыртуу 2: англис жана орус тилдеринде локализация кошулду, win7де иштөө сыналды
1C RAC үчүн GUI жазуу, же кайра Tcl/Tk жөнүндө

Source: www.habr.com

Комментарий кошуу