En explorant le sujet des produits 1C dans un environnement Linux, un inconvénient s'est manifesté : l'absence d'un outil graphique multiplateforme pratique pour gérer un cluster de serveurs 1C. Ainsi, il a été décidé de remédier à ce manque en développant une interface graphique pour l'utilitaire en ligne de commande rac. Le langage choisi pour le développement était Tcl/Tk, qui, à mon avis, est le plus adapté à cette tâche. Voici quelques aspects intéressants de cette solution que je souhaite présenter dans ce document.
Pour fonctionner, il faut des distributions Tcl/Tk et 1C. Comme j'ai choisi de maximiser les capacités de la version de base de Tcl/Tk sans utiliser de paquets externes, la version 8.6.7 est nécessaire, qui inclut ttk — un paquet avec des éléments graphiques supplémentaires, dont nous aurons principalement besoin de ttk::TreeView, qui permet d'afficher des données à la fois sous forme d'arborescence et sous forme de tableau (liste). De plus, dans la nouvelle version, la gestion des exceptions a été repensée (la commande try, qui est utilisée dans le projet lors du lancement des commandes externes).
Le projet se compose de plusieurs fichiers (même s'il est possible de tout faire en un seul) :
rac_gui.cfg — configuration par défaut
rac_gui.tcl — script principal de lancement
Dans le répertoire lib se trouvent les fichiers chargés automatiquement au démarrage :
function.tcl — fichier contenant des procédures
gui.tcl — interface graphique principale
images.tcl — bibliothèque d'images en base64
Le fichier rac_gui.tcl lance l'interpréteur, initialise les variables, charge les modules, les configurations, etc. Voici le contenu du fichier avec des 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 chargé tout ce dont nous avons besoin et vérifié la présence de l'utilitaire rac, une fenêtre graphique sera lancée. L'interface du programme se compose de trois éléments :
Barre d'outils, arbre et liste
Le contenu de « l'arbre » est conçu pour être aussi similaire que possible au composant Windows natif de 1C.
Le code principal formant cette fenêtre se trouve 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 de fonctionnement du programme est le suivant :
1. Dans un premier temps, il faut ajouter le serveur principal du cluster (c'est-à-dire le serveur de gestion du cluster (sur Linux, la gestion se lance par 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 du serveur et le port :
Ensuite, notre serveur apparaîtra dans l'arbre, sur lequel un clic ouvrira la liste des clusters ou affichera une erreur de connexion.
2. En cliquant sur le nom du cluster, une liste des fonctionnalités disponibles s'ouvrira.
3.…
Et ainsi de suite, c'est-à-dire pour ajouter un nouveau cluster, sélectionnez l'un des éléments disponibles dans la liste et appuyez sur le bouton « + » dans la barre d'outils, et une boîte de dialogue pour ajouter un nouveau cluster apparaîtra :
Les boutons de la barre d'outils exécutent des fonctions en fonction du contexte, c'est-à-dire que l'action effectuée dépend de l'élément de l'arbre ou de la liste sélectionné.
Considérons l'exemple du bouton d'ajout (« + ») :
Code de génération du bouton :
ttk::button $frm_tool.btn_add -command Add -image add_grey_32Ici, nous voyons que lorsque le bouton est cliqué, la procédure « Add » sera exécutée, son code :
proc Add {} {
global active_cluster host
# Définir l'identifiant de l'élément sélectionné
set id [.frm_tree.tree selection]
# Définir la valeur de cet élément
set values [.frm_tree.tree item [.frm_tree.tree selection] -values]
set key [lindex [split $id "::"] 0]
# selon ce que nous avons sélectionné, la procédure appropriée sera lancée
if {$key eq "" || $key eq "server"} {
set host [ Add::server ]
return
}
Add::$key .frm_tree.tree $host $values
}Voici l'un des avantages de Tcl — comme nom de procédure, vous pouvez passer la valeur d'une variable :
Add::$key .frm_tree.tree $host $valuesAinsi, par exemple, si nous cliquons sur le serveur principal et appuyons sur « + », la procédure Add::server sera lancée, si nous cliquons sur le cluster, la procédure Add::cluster, et ainsi de suite (je traiterai un peu plus bas d'où proviennent les « clés » nécessaires), les procédures listées dessinent des éléments graphiques correspondant au contexte.
Comme vous avez pu le remarquer, les formulaires ont un style similaire — ce qui n'est pas surprenant, car ils sont générés par une seule procédure, qui est en fait le cadre principal du formulaire (fenêtre, boutons, image, étiquette), le nom de la procédure 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
# étiquette avec icône
ttk::label $win_name.lbl -image $img
# cadre avec des champs de saisie
set frm [ttk::labelframe $win_name.frm -text $lbl -labelanchor nw]
grid columnconfigure $frm 0 -weight 1
grid rowconfigure $frm 0 -weight 1
# cadre et boutons
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 pour l'icône de la bibliothèque (lib/images.tcl) et un paramètre optionnel pour le nom de la fenêtre (par défaut .add). Ainsi, si l'on prend les exemples ci-dessus pour l'ajout du serveur principal et du cluster, l'appel sera respectivement :
AddToplevel "Ajout du serveur principal" server_grey_64ou
AddToplevel "Ajout du cluster" cluster_grey_64Et en continuant avec ces exemples, je vais montrer les procédures qui affichent les dialogues d'ajout pour un serveur ou un cluster.
Add::server
proc Add::server {} {
global default
# affichons le formulaire principal
set frm [AddToplevel "Ajout du serveur principal" server_grey_64]
# ajoutons des étiquettes et des champs de saisie à ce formulaire
label $frm.lbl_host -text "Adresse du serveur"
entry $frm.ent_host
label $frm.lbl_port -text "Port"
entry $frm.ent_port
$frm.ent_port insert end $default(port)
grid $frm.lbl_host -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_host -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_port -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_port -row 1 -column 1 -sticky nsew -padx 5 -pady 5
grid columnconfigure $frm 0 -weight 1
grid rowconfigure $frm 0 -weight 1
#set frm_btn [frame .add.frm_btn -border 0]
# redéfinissons le gestionnaire de pression du bouton
.add.frm_btn.btn_ok configure -command {
set host [SaveMainServer [.add.frm.ent_host get] [.add.frm.ent_port get]]
.frm_tree.tree insert {} end -id "server::$host" -text "$host" -values "$host"
destroy .add
return $host
}
return $frm
}Add::cluster
proc Add::cluster {tree host values} {
global default lifetime_limit expiration_timeout session_fault_tolerance_level
global max_memory_size max_memory_time_limit errors_count_threshold security_level
global load_balancing_mode kill_problem_processes
agent_user agent_pwd cluster_user cluster_pwd auth_agent
if {$agent_user ne "" && $agent_pwd ne ""} {
set auth_agent "--agent-user=$agent_user --agent-pwd=$agent_pwd"
} else {
set auth_agent ""
}
# definir les variables globales ()
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 "Ajout d'un cluster" cluster_grey_64]
label $frm.lbl_host -text "Adresse du serveur principal"
entry $frm.ent_host
label $frm.lbl_port -text "Port"
entry $frm.ent_port
$frm.ent_port insert end $default(port)
label $frm.lbl_name -text "Nom du cluster"
entry $frm.ent_name
label $frm.lbl_secure_connect -text "Connexion sécurisée"
ttk::combobox $frm.cb_security_level -textvariable security_level -values $default(security_level)
label $frm.lbl_expiration_timeout -text "Arrêter les processus éteints après:"
entry $frm.ent_expiration_timeout -textvariable expiration_timeout
label $frm.lbl_session_fault_tolerance_level -text "Niveau de tolérance aux pannes"
entry $frm.ent_session_fault_tolerance_level -textvariable session_fault_tolerance_level
label $frm.lbl_load_balancing_mode -text "Mode de répartition de la charge"
ttk::combobox $frm.cb_load_balancing_mode -textvariable load_balancing_mode
-values $default(load_balancing_mode)
label $frm.lbl_errors_count_threshold -text "Écart acceptable dans le nombre d'erreurs du serveur, %"
entry $frm.ent_errors_count_threshold -textvariable errors_count_threshold
label $frm.lbl_processes -text "Processus de travail:"
label $frm.lbl_lifetime_limit -text "Période de redémarrage, sec."
entry $frm.ent_lifetime_limit -textvariable lifetime_limit
label $frm.lbl_max_memory_size -text "Taille de mémoire autorisée, Ko"
entry $frm.ent_max_memory_size -textvariable max_memory_size
label $frm.lbl_max_memory_time_limit -text "Intervalle de dépassement de la taille de mémoire autorisée, sec."
entry $frm.ent_max_memory_time_limit -textvariable max_memory_time_limit
label $frm.lbl_kill_problem_processes -justify left -anchor nw -text "Terminer de force les processus problématiques"
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
# redéfinir le gestionnaire
.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 vais me concentrer sur le gestionnaire du bouton « Ok ». Dans Tk, les propriétés des éléments graphiques peuvent être redéfinies pendant l'exécution du programme grâce à l'option configure. 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é requise :
.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 « est configuré » pour lancer la procédure d'ajout de cluster.
Il est important de faire une parenthèse sur la manipulation des éléments graphiques dans Tk — pour différents éléments de saisie de données (entry, combobox, checkbutton, etc.), un paramètre appelé variable texte (textvariable) a été introduit :
entry $frm.ent_lifetime_limit -textvariable lifetime_limitCette variable est définie dans l'espace de noms global et contient la valeur actuellement saisie. Autrement dit, pour obtenir le texte saisi dans le champ, il suffit de lire la valeur de la variable correspondante (bien sûr, à condition qu'elle soit définie lors de la création de l'élément).
La deuxième méthode pour obtenir le texte saisi (pour les éléments de type entry) consiste à utiliser la commande get :
.add.frm.ent_name getCes deux méthodes peuvent être vues dans le code ci-dessus.
L'appui sur ce bouton, dans ce cas, déclenche la procédure RunCommand avec la chaîne de commande formée pour l'ajout du 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:1545Voici la commande principale qui gère le démarrage de rac avec les paramètres nécessaires, analyse également la sortie des commandes en listes et renvoie, si besoin est :
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
# Ouvrir un canal en mode non-bloquant
# $rac - commande avec le chemin complet
# $par - clés et options de lancement formées
set pipe [open "|$rac_cmd $par" "r"]
try {
set lst ""
set l ""
# La sortie de la commande est ajoutée à la liste
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} {
# Lancer le gestionnaire d'erreurs
ErrorParcing $result $options
return ""
}
}Après l'entrée des données du serveur principal, il sera ajouté à l'arbre, pour cela, le code suivant dans la procédure Add:server est responsable :
.frm_tree.tree insert {} end -id "server::$host" -text "$host" -values "$host"Maintenant, en cliquant sur le nom du serveur dans l'arbre, nous obtiendrons la liste des clusters gérés par ce serveur, et en cliquant sur un cluster, nous auront la liste des éléments du cluster (serveurs, bases d'informations, etc.). Cela est réalisé dans la procédure TreePress (fichier lib/function.tcl) :
proc TreePress {tree} {
global host server active_cluster infobase
# Déterminer l'élément sélectionné
set id [$tree selection]
# Définir les variables globales nécessaires
SetGlobalVarFromTreeItems $tree $id
# Déterminer la clé et la valeur, c'est-à-dire le type de l'élément sélectionné
set values [$tree item $id -values]
set key [lindex [split $id "::"] 0]
# et selon ce qui a été sélectionné, la procédure correspondante sera lancée
# dans l'espace de noms Run
Run::$key $tree $host $values
}En conséquence, pour le serveur principal, Run::server sera lancé (pour le cluster — Run::cluster, pour le serveur de travail — Run::work_server, etc.). Ainsi, la valeur de la variable $key est une partie du nom de l'élément de l'arbre, déterminée par l'option -id.
Notons la procédure
Run::server
proc Run::server {tree host values} {
# obtenir la liste des clusters du serveur requis
set lst [RunCommand server::$host "cluster list $host"]
if {$lst eq ""} {return}
set l [lindex $lst 0]
#puts $lst
# supprimer les éléments superflus de la liste
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
# lire la liste
foreach cluster_list $lst {
# Remplir la liste avec les valeurs obtenues
InsertItemsWorkList $cluster_list
# traiter la sortie (liste) pour ajouter des données à l'arbre
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]]
}
}
}
# ajouter les clusters à l'arbre
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"
# ajouter des éléments au cluster
InsertClusterItems $tree $id
}
}
if { [$tree exists "agent_admins::$id"] == 0 } {
$tree insert "server::$host" end -id "agent_admins::$id" -text "Administrateurs" -values "$id"
#InsertClusterItems $tree $id
}
}Cette procédure traite ce qui a été obtenu du serveur via la commande RunCommand et ajoute différentes choses à l'arbre : clusters, divers éléments racines (bases de données, serveurs de travail, sessions, etc.). Si l'on regarde de plus près, on peut remarquer l'appel à la procédure InsertItemsWorkList. Elle est utilisée pour ajouter des éléments à la liste graphique, traitant la sortie de l'outil console rac, qui avait précédemment été renvoyée sous forme de liste dans la variable $lst. Il s'agit d'une liste de listes, contenant des paires d'éléments séparés par des deux-points.
Par exemple, la liste des connexions à un 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
Visuellement, cela ressemblerait à peu près à ceci :
La procédure susmentionnée extrait les noms des éléments pour le titre et les données pour remplir le tableau :
InsertItemsWorkList
proc InsertItemsWorkList {lst} {
global work_list_row_count
# définition de l'alternance des couleurs pour la ligne
if [expr $work_list_row_count % 2] {
set tag dark
} else {
set tag light
}
# analyse des lignes en paires clé - valeur
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]
}
}
# remplissage du tableau
.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
# définition des en-têtes
foreach j $column_list {
.frm_work.tree_work heading $j -text $j
}
incr work_list_row_count
}Ici, au lieu de la 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 a été utilisée, car certains éléments contiennent également des deux-points.
La procédure InsertClusterItems (l'une des plusieurs du même type) ajoute simplement à l'arbre l'élément cluster les listes d'éléments enfants avec les identifiants correspondants.
InsertClusterItems
proc InsertClusterItems {tree id} {
set parent "cluster::$id"
$tree insert $parent end -id "infobases::$id" -text "Bases de données" -values "$id"
$tree insert $parent end -id "servers::$id" -text "Serveurs de travail" -values "$id"
$tree insert $parent end -id "admins::$id" -text "Administrateurs" -values "$id"
$tree insert $parent end -id "managers::$id" -text "Managers de cluster" -values $id
$tree insert $parent end -id "processes::$id" -text "Processus de travail" -values "workprocess-all"
$tree insert $parent end -id "sessions::$id" -text "Sessions" -values "sessions-all"
$tree insert $parent end -id "locks::$id" -text "Verrous" -values "blocks-all"
$tree insert $parent end -id "connections::$id" -text "Connexions" -values "connections-all"
$tree insert $parent end -id "profiles::$id" -text "Profils de sécurité" -values $id
}
On peut envisager encore deux variantes de mise en œuvre d'une telle procédure, où il sera clairement visible comment optimiser et se débarrasser des commandes répétées :
Dans cette procédure, l'ajout et la vérification ont été résolus directement :
InsertBaseItems
proc InsertBaseItems {tree id} {
set parent "infobase::$id"
if { [$tree exists "sessions::$id"] == 0 } {
$tree insert $parent end -id "sessions::$id" -text "Sessions" -values "$id"
}
if { [$tree exists "locks::$id"] == 0 } {
$tree insert $parent end -id "locks::$id" -text "Verrous" -values "$id"
}
if { [$tree exists "connections::$id"] == 0 } {
$tree insert $parent end -id "connections::$id" -text "Connexions" -values "$id"
}
}
Et ici, l'approche est plus correcte :
InsertProfileItems
proc InsertProfileItems {tree id} {
set parent "profile::$id"
set lst {
{dir "Répertoires virtuels"}
{com "Classes COM autorisées"}
{addin "Composants externes"}
{module "Rapports externes et traitements"}
{app "Applications autorisées"}
{inet "Ressources Internet"}
}
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 de la boucle, dans laquelle la commande (les commandes) répétitive est exécutée. Le choix de l'approche à adopter dépend déjà du développeur.
Nous avons abordé l'ajout d'éléments et la récupération de données, il est maintenant temps de s'attarder sur l'édition. Étant donné qu'en général, les mêmes paramètres sont utilisés pour l'édition et l'ajout (à l'exception de la base d'informations), les formulaires de dialogue sont donc identiques. L'algorithme d'appel des procédures pour l'ajout est le suivant :
Add::$key->AddToplevel
Et pour l'édition, c'est ainsi :
Edit::$key->Add::$key->AddTopLevel
Prenons comme exemple l'édition d'un cluster, c'est-à-dire en cliquant sur le nom du cluster dans l'arbre, nous appuyons sur le bouton d'édition dans la barre d'outils (le petit crayon) et le formulaire correspondant s'affiche à l'écran :
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 ""
}
# dessiner le formulaire pour le cluster
set frm [Add::cluster $tree $host $values]
# changer le texte sur l'étiquette
$frm configure -text "Édition du cluster"
set active_cluster $values
# obtenir les données du cluster sélectionné
set lst [RunCommand cluster::$values "cluster info --cluster=$active_cluster $host"]
# remplir les champs
FormFieldsDataInsert $frm $lst
# désactiver les champs dont la modification est interdite
$frm.ent_host configure -state disable
$frm.ent_port configure -state disable
# réassigner le gestionnaire
.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
}
}Dans les commentaires du code, en principe, tout est clair, sauf que le gestionnaire de bouton a été redéfini et qu'il y a une procédure FormFieldsDataInsert, qui remplit les champs avec les données et initialise les variables :
FormFieldsDataInsert
proc FormFieldsDataInsert {frm lst} {
foreach i [lindex $lst 0] {
# obtenir la liste des paramètres et valeurs
if [regexp -nocase -all -- {(D+)(s*?|)(:)(s*?|)(.*)} $i match param v2 v3 v4 value] {
# changer les symboles
regsub -all -- "-" [string trim $param] "_" entry_name
# remplir avec les données
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 """]
}
# pour les cases à cocher, changer les valeurs
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 du tcl émerge : les valeurs d'autres variables sont utilisées comme noms de variables. Cela signifie que pour l'automatisation du remplissage des formulaires et l'initialisation des variables, les noms des champs et des variables correspondent aux clés de la ligne de commande de l'outil rac et aux noms des paramètres de sortie des commandes, à quelques exceptions près : le tiret est remplacé par un trait de soulignement. Par exemple, scheduled-jobs-deny correspond au champ ent_scheduled_jobs_deny et à la variable scheduled_jobs_deny.
Les formulaires d'ajout et de modification peuvent différer par leur composition. Par exemple, le travail avec la base d'information :
Ajout d'IB
Modification d'IB
Dans la procédure de modification Edit::infobase, les champs nécessaires sont ajoutés au formulaire, le code étant volumineux, je ne le montre pas ici.
Des procédures analogues ont été mises en œuvre pour l'ajout, la modification et la suppression des autres éléments.
Comme l'utilisation de l'outil implique un nombre illimité de serveurs, de clusters, de bases d'information, etc., plusieurs variables globales ont été introduites pour déterminer à quel cluster appartient quel serveur ou IB, dont les valeurs sont définies à chaque clic sur les éléments de l'arbre. Cela signifie que la procédure parcourt récursivement 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 permet de fonctionner avec ou sans authentification. Il existe deux types d'administrateurs — l'administrateur de l'agent de cluster et l'administrateur de cluster. Par conséquent, pour un fonctionnement correct, quatre autres variables globales ont été introduites, contenant le nom d'utilisateur et le mot de passe de l'administrateur. Cela signifie que si un compte administrateur est présent dans le cluster, une boîte de dialogue s'affichera pour saisir le nom d'utilisateur et le mot de passe, ces informations seront sauvegardées en mémoire et utilisées dans chaque commande pour le cluster correspondant.
C'est la procédure de gestion des erreurs qui s'en occupe.
ErrorParcing
proc ErrorParcing {err opt} {
global cluster_user cluster_pwd agent_user agent_pwd
switch -regexp -- $err {
"L'administrateur du cluster n'est pas authentifié" {
AuthorisationDialog "Administrateur du cluster"
.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
}
"L'administrateur du serveur central n'est pas authentifié" {
AuthorisationDialog "Administrateur de l'agent du cluster"
.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 "Administrateur du cluster"
.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 "Administrateur de l'agent du cluster"
.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"
}
}
}C'est-à-dire qu'en fonction de ce que renvoie la commande, la réaction sera correspondante.
Actuellement, la fonctionnalité est réalisée à environ 95 %, il reste à mettre en œuvre le travail avec les profils de sécurité et à effectuer des tests =). Voilà tout. Je m'excuse pour le récit un peu désordonné.
Le code, comme d'habitude, est disponible. .
Mise à jour : J'ai terminé le travail sur les profils de sécurité. La fonctionnalité est maintenant complètement réalisée à 100%.
Mise à jour 2 : ajout de la localisation en anglais et en russe, vérification du fonctionnement sous win7.
Source : habr.com
