Escribiendo una GUI para 1C RAC, o nuevamente sobre Tcl/Tk

A medida que profundizaba en el tema del trabajo con productos de 1C en el entorno de Linux, encontré un inconveniente: la falta de una herramienta gráfica multiplataforma conveniente para administrar un clúster de servidores 1C. Se decidió solucionar esta carencia mediante la creación de una GUI para la utilidad de consola rac. Se eligió el lenguaje tcl/tk como el más adecuado para esta tarea. A continuación, quiero presentar algunos aspectos interesantes de la solución en este material.

Para trabajar, se necesitarán las distribuciones de tcl/tk y 1C. Dado que decidí aprovechar al máximo las capacidades de la distribución básica de tcl/tk sin utilizar paquetes externos, necesitaré la versión 8.6.7, que incluye ttk, un paquete con elementos gráficos adicionales, de los cuales principalmente necesitaremos ttk::TreeView, que permite mostrar datos tanto en forma de estructura jerárquica como en forma de tabla (lista). Además, en la nueva versión se ha mejorado el trabajo con excepciones (el comando try, que se utiliza en el proyecto al ejecutar comandos externos).

El proyecto consta de varios archivos (aunque nada impide hacerlo todo en uno):

rac_gui.cfg — configuración predeterminada
rac_gui.tcl — script principal de inicio
En el directorio lib se encuentran los archivos que se cargan automáticamente al iniciar:
function.tcl — archivo con procedimientos
gui.tcl — interfaz gráfica principal
images.tcl — biblioteca de imágenes en base64

El archivo rac_gui.tcl, en realidad, inicia el intérprete, inicializa variables, carga módulos, configuraciones, etc. El contenido del archivo con comentarios:

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

Después de cargar todo lo necesario y verificar la existencia de la utilidad rac, se abrirá la ventana gráfica. La interfaz del programa consta de tres elementos:

Barra de herramientas, árbol y lista

El contenido del "árbol" lo hice lo más parecido posible a la herramienta nativa de Windows de 1C.

Escribiendo una GUI para 1C RAC, o nuevamente sobre Tcl/Tk

El código principal que forma esta ventana se encuentra en el archivo
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

El algoritmo para trabajar con el programa es el siguiente:

1. Primero, es necesario agregar el servidor principal del clúster (es decir, el servidor de gestión del clúster (en Linux, la gestión se inicia con el comando “/opt/1C/v8.3/x86_64/ras cluster --daemon”)).

Para ello, presione el botón “+” y en la ventana emergente, ingrese la dirección del servidor y el puerto:

Escribiendo una GUI para 1C RAC, o nuevamente sobre Tcl/Tk

Luego, en el árbol aparecerá nuestro servidor, al hacer clic en él se abrirá la lista de clústeres o se mostrará un error de conexión.

2. Al hacer clic en el nombre del clúster se abrirá una lista de funciones disponibles para él.

3.…

Y así sucesivamente, es decir, para agregar un nuevo clúster, seleccionamos cualquier elemento disponible en la lista y pulsamos el botón «+» en la barra de herramientas, lo que abrirá un diálogo para agregar uno nuevo:

Escribiendo una GUI para 1C RAC, o nuevamente sobre Tcl/Tk

Los botones en la barra de herramientas realizan funciones según el contexto, es decir, dependiendo de qué elemento del árbol o lista esté seleccionado, se ejecutará un procedimiento u otro.

Veamos un ejemplo con el botón de agregar («+»):

Código para generar el botón:

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

Aquí vemos que al hacer clic en el botón se ejecutará el procedimiento «Add», su código:

proc Add {} {
    global active_cluster host
    # Definimos el identificador del elemento seleccionado
    set id  [.frm_tree.tree selection]
    # Definimos el valor de este elemento
    set values [.frm_tree.tree item [.frm_tree.tree selection] -values]
    set key [lindex [split $id "::"] 0]
    # Dependiendo de lo que seleccionamos se ejecutará el procedimiento correspondiente
    if {$key eq "" || $key eq "server"} {
        set host [ Add::server ]
        return
    }
    Add::$key .frm_tree.tree $host $values
}

Aquí se vislumbra una de las ventajas de Tick: como nombre del procedimiento se puede pasar el valor de una variable:

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

Es decir, por ejemplo, si hacemos clic en el servidor principal y presionamos «+», se ejecutará el procedimiento Add::server; si estamos en un clúster, Add::cluster, y así sucesivamente (sobre de dónde provienen las «claves» necesarias escribiré un poco más abajo), los procedimientos enumerados dibujan los elementos gráficos correspondientes al contexto.

Como ya habrán notado, los formularios son similares en estilo, lo cual no es sorprendente, ya que se generan mediante un solo procedimiento, más precisamente el armazón principal del formulario (ventana, botones, imagen, etiqueta), el nombre del procedimiento 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
    # etiqueta con icono
    ttk::label $win_name.lbl -image $img
    # marco con campos de entrada
    set frm [ttk::labelframe $win_name.frm -text $lbl -labelanchor nw]
    
    grid columnconfigure $frm 0 -weight 1
    grid rowconfigure $frm 0 -weight 1
    # marco y botones
    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
}

Parámetros de llamada: título, nombre de la imagen para el ícono de la biblioteca (lib/images.tcl) y un parámetro opcional para el nombre de la ventana (por defecto .add). Por lo tanto, si tomamos los ejemplos anteriores para agregar un servidor principal y un clúster, la llamada será respectivamente:

AddToplevel "Añadir servidor principal" server_grey_64

o

AddToplevel "Añadir clúster" cluster_grey_64

Continuando con estos ejemplos, mostraré los procedimientos que presentan los diálogos para añadir un servidor o un clúster.

Add::server

proc Add::server {} {
    global default
    # mostramos el formulario principal
    set frm [AddToplevel "Añadir servidor principal" server_grey_64]
    # añadimos etiquetas y campos de entrada a este formulario
    label $frm.lbl_host -text "Dirección del servidor"
    entry  $frm.ent_host
    label $frm.lbl_port -text "Puerto"
    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]
    # redefinimos el manejador de clic de botón
    .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 ""
    }
    # establecer 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 "Agregar clúster" cluster_grey_64]
    
    label $frm.lbl_host -text "Dirección del servidor principal"
    entry  $frm.ent_host
    label $frm.lbl_port -text "Puerto"
    entry $frm.ent_port 
    $frm.ent_port  insert end $default(port)
    label $frm.lbl_name -text "Nombre del clúster"
    entry  $frm.ent_name
    label $frm.lbl_secure_connect -text "Conexión segura"
    ttk::combobox $frm.cb_security_level -textvariable security_level -values $default(security_level)
    label $frm.lbl_expiration_timeout -text "Detener procesos apagados después de:"
    entry  $frm.ent_expiration_timeout -textvariable expiration_timeout
    label $frm.lbl_session_fault_tolerance_level -text "Nivel de tolerancia a fallos"
    entry  $frm.ent_session_fault_tolerance_level -textvariable session_fault_tolerance_level
    label $frm.lbl_load_balancing_mode -text "Modo de balanceo de carga"
    ttk::combobox $frm.cb_load_balancing_mode -textvariable load_balancing_mode 
    -values $default(load_balancing_mode)
    label $frm.lbl_errors_count_threshold -text "Tolerancia al número de errores del servidor, %"
    entry  $frm.ent_errors_count_threshold -textvariable errors_count_threshold
    label $frm.lbl_processes -text "Procesos de trabajo:"
    label $frm.lbl_lifetime_limit -text "Período de reinicio, seg."
    entry  $frm.ent_lifetime_limit -textvariable lifetime_limit
    label $frm.lbl_max_memory_size -text "Tamaño máximo de memoria, KB"
    entry  $frm.ent_max_memory_size -textvariable max_memory_size
    label $frm.lbl_max_memory_time_limit -text "Intervalo de excedencia del tamaño máximo de memoria, seg."
    entry  $frm.ent_max_memory_time_limit -textvariable max_memory_time_limit
    label $frm.lbl_kill_problem_processes -justify left -anchor nw -text "Eliminar procesos problemáticos forzosamente"
    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
    # redefinir manejador
    .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
}

Al comparar el código de estos procedimientos, la diferencia es evidente a simple vista, y me enfocaré en el manejador del botón «Aceptar». En Tk, las propiedades de los elementos gráficos se pueden redefinir durante la ejecución del programa a través de opciones — simplemente ejecuto. Por ejemplo, el comando inicial para mostrar el botón:

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

Sin embargo, en nuestros formularios el comando depende de la funcionalidad requerida:

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

En el ejemplo anterior, al botón se le asigna la ejecución del procedimiento para agregar el clúster.

Aquí vale la pena hacer una pausa en cuanto al trabajo con elementos gráficos en Tk: para diversos elementos de entrada de datos (entry, combobox, checkbutton, etc.) se ha introducido un parámetro llamado variable de texto (textvariable):

entry  $frm.ent_lifetime_limit -textvariable lifetime_limit

Esta variable está definida en el espacio de nombres global y contiene el valor actual ingresado. Es decir, para obtener el texto ingresado en el campo, simplemente hay que leer el valor de la variable correspondiente (por supuesto, siempre que esté definida al crear el elemento).

El segundo método para obtener el texto ingresado (para elementos de tipo entry) es utilizar el comando get:

.add.frm.ent_name get

Ambos métodos se pueden ver en el código anterior.

Presionar este botón, en este caso, inicia el procedimiento RunCommand con la cadena de comando generada para agregar el clúster en los términos 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

Y aquí llegamos al comando principal, que gestiona la ejecución de rac con los parámetros que necesitamos, también analiza la salida de los comandos en listas y devuelve, si es necesario:

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
    # Abrimos un canal en modo no bloqueante
    # $rac - comando con la ruta completa
    # $par - claves de inicio formadas y opciones
    set pipe [open "|$rac_cmd $par" "r"]
    try {
        set lst ""
        set l ""
        # Agregamos la salida del comando a la lista
        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} {
        # Lanzamos el manejador de errores
        ErrorParcing $result $options
        return ""
    }
}

Después de ingresar los datos del servidor principal, este se añadirá al árbol, para lo cual el siguiente código en la procedimiento Add:server es responsable:

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

Ahora, al hacer clic en el nombre del servidor en el árbol, obtendremos una lista de clústeres gestionados por dicho servidor, y al hacer clic en un clúster, obtendremos una lista de los elementos del clúster (servidores, bases de datos de información, etc.). Esto se implementa en el procedimiento TreePress (archivo lib/function.tcl):

proc TreePress {tree} {
   global host server active_cluster infobase
   # Determinamos el elemento seleccionado
    set id  [$tree selection]
   # Establecemos las variables globales necesarias
    SetGlobalVarFromTreeItems $tree $id
   # Determinamos la clave y el valor, es decir, el tipo de elemento seleccionado
    set values [$tree item $id -values]
    set key [lindex [split $id "::"] 0]
   # Y dependiendo de lo que se seleccione se ejecutará el procedimiento correspondiente
   # en el espacio de nombres Run
    Run::$key $tree $host $values
}

Por lo tanto, para el servidor principal se ejecutará Run::server (para el clúster — Run::cluster, para el servidor de trabajo — Run::work_server, etc.). Es decir, el valor de la variable $key es parte del nombre del elemento del árbol, determinado por la opción -id.

Observemos el procedimiento

Run::server

proc Run::server {tree host values} {
    # Obtenemos la lista de clústeres del servidor requerido
    set lst [RunCommand server::$host "cluster list $host"]
    if {$lst eq ""} {return}
    set l [lindex $lst 0]
    #puts $lst
    # Eliminamos elementos innecesarios de la lista
    .frm_work.tree_work delete  [ .frm_work.tree_work children {}]
    # Leemos la lista
    foreach cluster_list $lst {
        # Llenamos la lista con los valores obtenidos
        InsertItemsWorkList $cluster_list
        # Procesamos la salida (lista) para agregar datos al árbol
        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]]
            }
        }
    }
    # Agregamos los clústeres al árbol
    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"
            # Agregamos elementos al clúster
            InsertClusterItems $tree $id
        }
    }
    if { [$tree exists "agent_admins::$id"] == 0 } {
        $tree insert "server::$host" end -id "agent_admins::$id" -text "Administradores" -values "$id"
        #InsertClusterItems $tree $id
    }
}

Este procedimiento procesa lo que ha sido obtenido del servidor a través del comando RunCommand, y añade varios elementos al árbol — clústeres, diferentes elementos raíz (bases de datos, servidores de trabajo, sesiones, etc.). Si se observa de cerca, se puede notar la llamada al procedimiento InsertItemsWorkList. Se utiliza para agregar elementos a la lista gráfica, procesando la salida de la utilidad de consola rac, que anteriormente fue devuelta en forma de lista a la variable $lst. Esta es una lista de listas, que contiene pares de elementos separados por dos puntos.

Por ejemplo, la lista de conexiones de clúster:

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

Visualmente, esto se verá aproximadamente así:

Escribiendo una GUI para 1C RAC, o nuevamente sobre Tcl/Tk

El procedimiento mencionado anteriormente extrae los nombres de los elementos para el encabezado y los datos para llenar la tabla:

InsertItemsWorkList

proc InsertItemsWorkList {lst} {
    global work_list_row_count
    # configuración del color alterno para la fila
    if [expr $work_list_row_count % 2] {
        set tag oscuro
    } else {
        set tag claro
    }
    # análisis de filas en pares clave - valor
    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]
        }
    }
     # llenado de la tabla
    .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
    # configuración de los encabezados
    foreach j $column_list {
        .frm_work.tree_work heading $j -text $j
    }
    incr work_list_row_count
}

Aquí en lugar de un simple comando [split $str «:»], que divide la cadena en elementos separados por «:» y devuelve una lista, se ha aplicado una expresión regular, ya que algunos elementos también contienen dos puntos.

El procedimiento InsertClusterItems (uno de varios similares) simplemente agrega al árbol el conjunto de elementos secundarios con los identificadores correspondientes al elemento cluster requerido.
InsertClusterItems

proc InsertClusterItems {tree id} {
    set parent "cluster::$id"
    $tree insert $parent end -id "infobases::$id" -text "Bases de información" -values "$id"
    $tree insert $parent end -id "servers::$id" -text "Servidores de trabajo" -values "$id"
    $tree insert $parent end -id "admins::$id" -text "Administradores" -values "$id"
    $tree insert $parent end -id "managers::$id" -text "Gerentes de cluster" -values $id
    $tree insert $parent end -id "processes::$id" -text "Procesos de trabajo" -values "workprocess-all"
    $tree insert $parent end -id "sessions::$id" -text "Sesiones" -values "sessions-all"
    $tree insert $parent end -id "locks::$id" -text "Bloqueos" -values "blocks-all"
    $tree insert $parent end -id "connections::$id" -text "Conexiones" -values "connections-all"
    $tree insert $parent end -id "profiles::$id" -text "Perfiles de seguridad" -values $id
}

Se pueden considerar otras dos variantes de implementación de un procedimiento similar, donde será evidente cómo se puede optimizar y eliminar comandos duplicados:

En este procedimiento, la adición y la verificación se abordan de manera superficial:

InsertBaseItems

proc InsertBaseItems {tree id} {
    set parent "infobase::$id"
    if { [$tree exists "sessions::$id"] == 0 } {
        $tree insert $parent end -id "sessions::$id" -text "Sesiones" -values "$id"
    }
    if { [$tree exists "locks::$id"] == 0 } {
        $tree insert $parent end -id "locks::$id" -text "Bloqueos" -values "$id"
    }
    if { [$tree exists "connections::$id"] == 0 } {
        $tree insert $parent end -id "connections::$id" -text "Conexiones" -values "$id"
    }
}

Aquí el enfoque es más correcto:

InsertProfileItems

proc InsertProfileItems {tree id} {
    set parent "profile::$id"
    set lst {
        {dir "Directorios virtuales"}
        {com "Clases COM permitidas"}
        {addin "Componentes externos"}
        {module "Informes y tratamientos externos"}
        {app "Aplicaciones permitidas"}
        {inet "Recursos de 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 diferencia entre ellos radica en la aplicación de un ciclo, en el cual se ejecuta el comando (o los comandos) repetidamente. Qué enfoque adoptar ya depende del desarrollador.

Hemos discutido la adición de elementos y la obtención de datos, ahora es tiempo de detenernos en la edición. Dado que, en general, se utilizan los mismos parámetros para editar y agregar (la base de información es la excepción), las formas de diálogo son las mismas. El algoritmo para invocar procedimientos para agregar es el siguiente:

Add::$key->AddToplevel

Y para editar es así:

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

Tomemos como ejemplo la edición de un clúster, es decir, al hacer clic en el árbol sobre el nombre del clúster, presionamos el botón de edición en la barra de herramientas (el icono de lápiz) y en pantalla aparecerá el formulario correspondiente:

Escribiendo una GUI para 1C RAC, o nuevamente sobre 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 ""
    }
    # dibujar el formulario para el clúster
    set frm [Add::cluster $tree $host $values]
    # cambiar el texto en la etiqueta
    $frm configure -text "Edición del clúster"
    
    set active_cluster $values
    # obtener datos sobre el clúster seleccionado
    set lst [RunCommand cluster::$values "cluster info --cluster=$active_cluster $host"]
    # llenar los campos
    FormFieldsDataInsert $frm $lst
    # deshabilitar campos que no pueden ser editados
    $frm.ent_host configure -state disable
    $frm.ent_port configure -state disable
    # reasignar el manejador
    .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
    }
}

Por los comentarios en el código, en principio, todo está claro, excepto que el código del manejador de botones ha sido redefinido y hay un procedimiento FormFieldsDataInsert que llena los campos con datos e inicializa variables:

FormFieldsDataInsert

proc FormFieldsDataInsert {frm lst} {
    foreach i [lindex $lst 0] {
        # obtener lista de parámetros y valores
        if [regexp -nocase -all -- {(D+)(s*?|)(:)(s*?|)(.*)} $i match param v2 v3 v4 value] {
            # cambiar caracteres
            regsub -all -- "-" [string trim $param] "_" entry_name
            # llenar con datos
            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 """]
            }
            # para checkboxes cambiar valores
            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
                }
            }
        }
    }
}

En este procedimiento ha surgido otra ventaja de tcl: los nombres de las variables pueden ser sustituidos por los valores de otras variables. Es decir, para la automatización del llenado de formularios e inicialización de variables, los nombres de los campos y las variables coinciden con las claves de la línea de comandos de la utilidad rac y los nombres de los parámetros de salida de los comandos, con algunas excepciones: el guion se reemplaza por un guion bajo. Por ejemplo scheduled-jobs-deny corresponde al campo ent_scheduled_jobs_deny y a la variable scheduled_jobs_deny.

Los formularios de adición y edición pueden diferir en los campos que contienen; por ejemplo, al trabajar con la base de datos de información:

Añadir IB

Escribiendo una GUI para 1C RAC, o nuevamente sobre Tcl/Tk

Editar IB

Escribiendo una GUI para 1C RAC, o nuevamente sobre Tcl/Tk

En el procedimiento de edición Edit::infobase, se añaden los campos necesarios al formulario; el código es extenso, por lo tanto, no lo incluyo aquí.

De manera análoga se han implementado procedimientos para añadir, editar y eliminar otros elementos.

Dado que el funcionamiento de la utilidad implica un número ilimitado de servidores, clústeres, bases de datos de información, etc., se han introducido varias variables globales para determinar a qué clúster pertenece cada servidor o IB; los valores de estas variables se establecen con cada clic en los elementos del árbol. Es decir, el procedimiento recorre recursivamente todos los elementos principales y asigna las 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
    }
}

El clúster 1C permite operaciones tanto con autorización como sin ella. Existen dos tipos de administradores: el administrador del agente del clúster y el administrador del clúster. Por lo tanto, se han introducido 4 variables globales adicionales que contienen el nombre de usuario y la contraseña del administrador. Es decir, si hay una cuenta de administrador en el clúster, se mostrará un diálogo para ingresar el nombre de usuario y la contraseña, los datos se guardarán en memoria y se utilizarán en cada comando para el clúster correspondiente.

Esto es gestionado por el procedimiento de manejo de errores

ErrorParcing

proc ErrorParcing {err opt} {
    global cluster_user cluster_pwd agent_user agent_pwd
        switch -regexp -- $err {
        "El administrador del clúster no está autenticado" {
            AuthorisationDialog "Administrador del clúster"
            .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
        }
        "El administrador del servidor central no está autenticado" {
            AuthorisationDialog "Administrador del agente del clúster"
            .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
            }
        }
        "Administrador del clúster no autenticado" {
            AuthorisationDialog "Administrador del clúster"
            .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
        }
        "El administrador del servidor central no está autenticado" {
            AuthorisationDialog "Administrador del agente del clúster"
            .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"
        }
    }
}

Es decir, dependiendo de lo que devuelva el comando, será la reacción correspondiente.

En este momento, la funcionalidad está implementada alrededor del 95%, solo queda implementar la gestión de perfiles de seguridad y hacer pruebas =). Eso es todo. Pido disculpas por la narración abrupta.

El código, como es habitual, está disponible aquí.

Actualización: He terminado el trabajo sobre los perfiles de seguridad. Ahora la funcionalidad está implementada al 100%.

Actualización 2: se agregó localización en inglés y ruso, se verificó el funcionamiento en Win7
Escribiendo una GUI para 1C RAC, o nuevamente sobre Tcl/Tk

Fuente: habr.com

Compra un hosting fiable para sitios web con protección contra DDoS, servidores VPS VDS 🔥 Compra un hosting fiable para sitios web con protección contra DDoS, servidores VPS VDS | ProHoster