Ecrire une interface graphique pour 1C RAC, ou encore à propos de Tcl/Tk

Alors que nous abordions le sujet du fonctionnement des produits 1C dans l'environnement Linux, un inconvénient a été découvert : l'absence d'un outil graphique multiplateforme pratique pour gérer un cluster de serveurs 1C. Et il a été décidé de corriger cet inconvénient en écrivant une interface graphique pour l'utilitaire de console rac. Tcl/tk a été choisi comme langage de développement car, à mon avis, le plus adapté à cette tâche. Et donc, je voudrais présenter quelques aspects intéressants de la solution dans ce document.

Pour travailler, vous aurez besoin des distributions tcl/tk et 1C. Et comme j'ai décidé de tirer le meilleur parti des capacités de la livraison de base tcl/tk sans utiliser de packages tiers, j'aurai besoin de la version 8.6.7, qui inclut ttk - un package avec des éléments graphiques supplémentaires, dont nous avons principalement besoin de ttk. ::TreeView, il permet d'afficher des données aussi bien sous forme d'arborescence que sous forme de tableau (liste). De plus, dans la nouvelle version, le travail avec les exceptions a été retravaillé (la commande try, qui est utilisée dans le projet lors de l'exécution de commandes externes).

Le projet est constitué de plusieurs fichiers (même si rien ne vous empêche de tout faire en un seul) :

rac_gui.cfg - configuration par défaut
rac_gui.tcl - script de lancement principal
Le répertoire lib contient les fichiers qui sont automatiquement chargés au démarrage :
function.tcl - fichier avec les procédures
gui.tcl - interface graphique principale
images.tcl - bibliothèque d'images base64

Le fichier rac_gui.tcl, en fait, démarre l'interpréteur, initialise les variables, charge les modules, les configurations, etc. Contenu du fichier avec commentaires :

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

Après avoir téléchargé tout ce qui est nécessaire et vérifié la présence de l'utilitaire rac, une fenêtre graphique s'ouvrira. L'interface du programme se compose de trois éléments :

Barre d'outils, arborescence et liste

J'ai rendu le contenu de « l'arborescence » aussi similaire que possible à l'équipement Windows standard de 1C.

Ecrire une interface graphique pour 1C RAC, ou encore à propos de Tcl/Tk

Le code principal qui forme cette fenêtre est contenu dans le fichier
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

L'algorithme pour travailler avec le programme est le suivant :

1. Tout d'abord, vous devez ajouter le serveur de cluster principal (c'est-à-dire le serveur de gestion de cluster (sous Linux, la gestion est lancée avec la commande « /opt/1C/v8.3/x86_64/ras cluster —daemon »)).

Pour cela, cliquez sur le bouton « + » et dans la fenêtre qui s'ouvre, saisissez l'adresse et le port du serveur :

Ecrire une interface graphique pour 1C RAC, ou encore à propos de Tcl/Tk

Ensuite, notre serveur apparaîtra dans l'arborescence en cliquant dessus, une liste de clusters s'ouvrira ou une erreur de connexion s'affichera.

2. Cliquer sur le nom du cluster ouvrira une liste des fonctions disponibles pour celui-ci.

3. ...

Et ainsi de suite, c'est-à-dire pour ajouter un nouveau cluster, sélectionnez celui disponible dans la liste et appuyez sur le bouton « + » dans la barre d'outils et la boîte de dialogue d'ajout d'un nouveau s'affichera :

Ecrire une interface graphique pour 1C RAC, ou encore à propos de Tcl/Tk

Les boutons de la barre d'outils remplissent des fonctions en fonction du contexte, c'est-à-dire Selon l'élément de l'arborescence ou de la liste sélectionné, l'une ou l'autre procédure sera effectuée.

Regardons l'exemple du bouton d'ajout (« + ») :

Code de génération du bouton :

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

On voit ici que lorsque l'on appuie sur le bouton, la procédure « Ajouter » sera exécutée, son 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
}

Voici un des avantages de tickle : vous pouvez passer la valeur d'une variable comme nom de procédure :

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

C'est-à-dire, par exemple, si nous pointons sur le serveur principal et appuyons sur "+", alors la procédure Add::server sera lancée, si sur le cluster - Add::cluster et ainsi de suite (j'écrirai sur l'endroit où le les « clés » nécessaires viennent un peu plus bas), les procédures listées dessinent des éléments graphiques adaptés au contexte.

Comme vous l'avez peut-être déjà remarqué, les formulaires sont de style similaire - ce n'est pas surprenant, car ils sont affichés par une seule procédure, plus précisément le cadre principal du formulaire (fenêtre, boutons, image, étiquette), le nom de la procédure Ajouter un niveau supérieur

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
}

Paramètres d'appel : titre, nom de l'image de l'icône de la bibliothèque (lib/images.tcl) et un paramètre facultatif de nom de fenêtre (par défaut .add). Ainsi, si nous prenons les exemples ci-dessus pour ajouter le serveur principal et le cluster, l'appel sera en conséquence :

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

ou

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

Eh bien, en continuant avec ces exemples, je vais montrer les procédures qui affichent des boîtes de dialogue d'ajout pour un serveur ou un cluster.

Ajouter :: serveur

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
}

Ajouter : cluster

proc Add::cluster {tree host values} {
    global default lifetime_limit expiration_timeout session_fault_tolerance_level
    global max_memory_size max_memory_time_limit errors_count_threshold security_level
    global load_balancing_mode kill_problem_processes 
    agent_user agent_pwd cluster_user cluster_pwd auth_agent
    if {$agent_user ne "" && $agent_pwd ne ""} {
        set auth_agent "--agent-user=$agent_user --agent-pwd=$agent_pwd"
    } else {
        set auth_agent ""
    }
    # устанавливаем глобальные переменные ()
    set lifetime_limit $default(lifetime_limit)
    set expiration_timeout $default(expiration_timeout)
    set session_fault_tolerance_level $default(session_fault_tolerance_level)
    set max_memory_size $default(max_memory_size)
    set max_memory_time_limit $default(max_memory_time_limit)
    set errors_count_threshold $default(errors_count_threshold)
    set security_level [lindex $default(security_level) 0]
    set load_balancing_mode [lindex $default(load_balancing_mode) 0]
    
    set frm [AddToplevel "Добавление кластера" 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
}

En comparant le code de ces procédures, la différence est visible à l'œil nu ; je me concentrerai sur le gestionnaire de bouton « Ok ». Dans Tk, les propriétés des éléments graphiques peuvent être remplacées lors de l'exécution du programme en utilisant l'option configurer. Par exemple, la commande initiale pour afficher le bouton :

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

Mais dans nos formulaires, la commande dépend de la fonctionnalité recherchée :

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

Dans l'exemple ci-dessus, le bouton « obstrué » lance la procédure d'ajout d'un cluster.

Ici, cela vaut la peine de faire une digression vers le travail avec des éléments graphiques dans Tk - pour divers éléments de saisie de données (entrée, combobox, bouton à cocher, etc.), un paramètre a été introduit en tant que variable de texte :

entry  $frm.ent_lifetime_limit -textvariable lifetime_limit

Cette variable est définie dans l'espace de noms global et contient la valeur actuellement saisie. Ceux. afin de récupérer le texte saisi dans le champ, il suffit de lire la valeur correspondant à la variable (à condition bien sûr qu'elle soit définie lors de la création de l'élément).

La deuxième méthode pour récupérer le texte saisi (pour les éléments de type entrée) consiste à utiliser la commande get :

.add.frm.ent_name get

Ces deux méthodes peuvent être vues dans le code ci-dessus.

Cliquer sur ce bouton, dans ce cas, lance la procédure RunCommand avec la ligne de commande générée pour ajouter un cluster en termes de 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

Venons-en maintenant à la commande principale, qui contrôle le lancement de rac avec les paramètres dont nous avons besoin, analyse également la sortie des commandes en listes et renvoie, si nécessaire :

ExécuterCommand

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

Après avoir saisi les données principales du serveur, elles seront ajoutées à l'arborescence, pour cela, dans la procédure Add:server ci-dessus, le code suivant est responsable :

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

Désormais, en cliquant sur le nom du serveur dans l'arborescence, nous obtenons une liste des clusters gérés par ce serveur, et en cliquant sur un cluster, nous obtenons une liste des éléments du cluster (serveurs, infobases, etc.). Ceci est implémenté dans la procédure TreePress (fichier 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
}

En conséquence, Run::server sera lancé pour le serveur principal (pour un cluster - Run::cluster, pour un serveur fonctionnel - Run::work_server, etc.). Ceux. la valeur de la variable $key fait partie du nom de l'élément d'arborescence spécifié par l'option -identifiant.

Faisons attention à la procédure

Exécuter :: serveur

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

Cette procédure traite ce qui a été reçu du serveur via la commande RunCommand et ajoute toutes sortes de choses à l'arborescence - clusters, divers éléments racine (bases, serveurs de travail, sessions, etc.). Si vous regardez attentivement, vous remarquerez un appel à la procédure InsertItemsWorkList à l'intérieur. Il est utilisé pour ajouter des éléments à une liste graphique en traitant la sortie de l'utilitaire de console rac, qui était auparavant renvoyée sous forme de liste à la variable $lst. Il s'agit d'une liste de listes contenant des paires d'éléments séparés par deux points.

Par exemple, une liste de connexions de cluster :

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

Sous forme graphique, cela ressemblera à ceci :

Ecrire une interface graphique pour 1C RAC, ou encore à propos de Tcl/Tk

La procédure ci-dessus sélectionne les noms des éléments pour l'en-tête et les données pour remplir le tableau :

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
}

Ici, au lieu d'une simple commande [split $str ":"], qui divise la chaîne en éléments séparés par ":" et renvoie une liste, une expression régulière est utilisée, car certains éléments contiennent également des deux-points.

La procédure InsertClusterItems (une parmi plusieurs procédures similaires) ajoute simplement une liste d'éléments enfants avec les identifiants correspondants à l'arborescence de l'élément de cluster requis.
Insérer des éléments de cluster

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
}

Vous pouvez envisager deux autres options pour mettre en œuvre une procédure similaire, où il sera clairement visible comment vous pouvez optimiser et vous débarrasser des commandes répétitives :

Dans cette procédure, l'ajout et la vérification sont résolus de front :

Insérer des éléments de base

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

Voici une approche plus correcte :

Insérer des éléments de profil

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

La différence entre eux réside dans l’utilisation d’une boucle dans laquelle la ou les commandes répétées sont exécutées. L'approche à utiliser est à la discrétion du développeur.

Nous avons abordé l'ajout d'éléments et la récupération de données. Il est maintenant temps de se concentrer sur l'édition. Puisque, fondamentalement, les mêmes paramètres sont utilisés pour l'édition et l'ajout (à l'exception de la base d'informations), les mêmes formulaires de dialogue sont utilisés. L'algorithme d'appel des procédures d'ajout ressemble à ceci :

Ajouter ::$key->AddToplevel

Et pour éditer comme ceci :

Edit ::$key->Ajouter ::$key->AddTopLevel

Par exemple, prenons l'édition d'un cluster, c'est-à-dire Après avoir cliqué sur le nom du cluster dans l'arborescence, appuyez sur le bouton éditer dans la barre d'outils (crayon) et le formulaire correspondant s'affichera à l'écran :

Ecrire une interface graphique pour 1C RAC, ou encore à propos de 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
    }
}

Sur la base des commentaires dans le code, en principe, tout est clair, sauf que le code du gestionnaire de boutons est remplacé et qu'il existe une procédure FormFieldsDataInsert qui remplit les champs avec des données et initialise les variables :

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

Dans cette procédure, un autre avantage de tcl est apparu : les valeurs d'autres variables sont remplacées comme noms de variables. Ceux. pour automatiser le remplissage des formulaires et l'initialisation des variables, les noms des champs et des variables correspondent aux commutateurs de ligne de commande de l'utilitaire rac et aux noms des paramètres de sortie de commande à quelques exceptions près - le tiret est remplacé par un trait de soulignement. Par exemple travaux planifiés-refusés correspond au terrain ent_scheduled_jobs_deny et variable emplois_programmés_deny.

Les formulaires d'ajout et de modification peuvent différer par la composition des champs, par exemple en travaillant avec une base d'informations :

Ajout de la sécurité des informations

Ecrire une interface graphique pour 1C RAC, ou encore à propos de Tcl/Tk

Modification de la sécurité des informations

Ecrire une interface graphique pour 1C RAC, ou encore à propos de Tcl/Tk

Dans la procédure d'édition Edit::infobase, les champs obligatoires sont ajoutés au formulaire ; le code est volumineux, je ne le présente donc pas ici.

Par analogie, des procédures d'ajout, d'édition, de suppression sont mises en œuvre pour d'autres éléments.

Étant donné que le fonctionnement de l'utilitaire implique un nombre illimité de serveurs, clusters, bases d'informations, etc., pour déterminer quel cluster appartient à quel serveur ou système de sécurité de l'information, plusieurs variables globales ont été introduites, dont les valeurs sont définies chacune chaque fois que vous cliquez sur les éléments de l'arbre. Ceux. la procédure parcourt de manière récursive tous les éléments parents et définit les variables :

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

Le cluster 1C vous permet de travailler avec ou sans autorisation. Il existe deux types d'administrateurs : l'administrateur d'agent de cluster et l'administrateur de cluster. En conséquence, pour un fonctionnement correct, 4 variables globales supplémentaires ont été introduites contenant le login et le mot de passe de l'administrateur. Ceux. s'il existe un compte administrateur dans le cluster, une boîte de dialogue s'affichera pour saisir votre identifiant et votre mot de passe, les données seront enregistrées en mémoire et insérées dans chaque commande pour le cluster correspondant.

C'est la responsabilité de la procédure de gestion des erreurs.

ErreurParcing

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

Ceux. en fonction de ce que renvoie la commande, la réaction sera en conséquence.

À l'heure actuelle, environ 95 pour cent des fonctionnalités ont été implémentées, il ne reste plus qu'à implémenter le travail avec les profils de sécurité et à le tester =). C'est tout. Je m'excuse pour l'histoire froissée.

Le code est traditionnellement disponible ici.

Mise à jour : j'ai fini de travailler avec les profils de sécurité. Désormais, la fonctionnalité est implémentée à 100 %.

Mise à jour 2 : la localisation en anglais et en russe a été ajoutée, le travail dans win7 a été testé
Ecrire une interface graphique pour 1C RAC, ou encore à propos de Tcl/Tk

Source: habr.com

Ajouter un commentaire