Scriviamo un GUI per 1C RAC, o di nuovo su Tcl/Tk.

Immergendo nel tema dei prodotti 1C nell'ambiente Linux, è emersa una mancanza: l'assenza di uno strumento grafico multipiattaforma conveniente per la gestione di un cluster di server 1C. È stato quindi deciso di colmare questa lacuna scrivendo un'interfaccia GUI per l'utilità della console rac. Il linguaggio scelto per lo sviluppo è stato tcl/tk, poiché lo considero il più adatto per questo compito. Qui voglio presentare alcuni aspetti interessanti della soluzione in questo documento.

Per il lavoro saranno necessari i pacchetti tcl/tk e 1C. Poiché ho deciso di sfruttare al massimo le funzionalità della distribuzione base di tcl/tk senza utilizzare pacchetti esterni, sarà necessaria la versione 8.6.7, che include ttk — un pacchetto con elementi grafici aggiuntivi, tra cui principalmente ttk::TreeView, che consente di visualizzare i dati sia come una struttura ad albero che come una tabella (lista). Inoltre, in questa nuova versione è stata rivisitata la gestione delle eccezioni (il comando try, utilizzato nel progetto per l'esecuzione di comandi esterni).

Il progetto è composto da diversi file (anche se nulla impedisce di fare tutto in uno):

rac_gui.cfg — configurazione di default
rac_gui.tcl — il principale script di avvio
Nella cartella lib ci sono i file caricati automaticamente all'avvio:
function.tcl — file con le procedure
gui.tcl — interfaccia grafica principale
images.tcl — libreria di immagini in base64

Il file rac_gui.tcl avvia l'interprete, inizializza le variabili, carica i moduli, le configurazioni e così via. Contenuto del file con commenti:

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

Dopo il caricamento di tutto il necessario e il controllo della presenza dell'utility rac, verrà aperta la finestra grafica. L'interfaccia del programma è composta da tre elementi:

Barra degli strumenti, albero e lista

Il contenuto dell'«albero» è stato reso il più simile possibile al pannello standard di Windows di 1C.

Scriviamo un GUI per 1C RAC, o di nuovo su Tcl/Tk.

Il codice principale che forma questa finestra è contenuto nel file
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'algoritmo di interazione con il programma è il seguente:

1. Inizialmente, è necessario aggiungere il server principale del cluster (ossia il server di gestione del cluster (in linux la gestione si avvia con il comando «/opt/1C/v8.3/x86_64/ras cluster —daemon»)).

Per farlo, cliccare il pulsante «+» e nella finestra che si apre, inserire l'indirizzo del server e la porta:

Scriviamo un GUI per 1C RAC, o di nuovo su Tcl/Tk.

Dopo, nell'albero apparirà il nostro server, cliccandoci sopra si aprirà l'elenco dei cluster o verrà visualizzato un errore di connessione.

2. Cliccando sul nome del cluster si aprirà un elenco delle funzionalità disponibili per esso.

3.…

E così via; per aggiungere un nuovo cluster, selezioniamo uno qualsiasi disponibile nell'elenco e premiamo il pulsante «+» nella barra degli strumenti e si aprirà un dialogo per l'aggiunta del nuovo:

Scriviamo un GUI per 1C RAC, o di nuovo su Tcl/Tk.

I pulsanti nella barra degli strumenti svolgono funzioni a seconda del contesto, cioè a seconda di quale elemento dell'albero o dell'elenco è selezionato, verrà eseguita una certa procedura.

Consideriamo l'esempio del pulsante di aggiunta («+»):

Codice per la creazione del pulsante:

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

Qui vediamo che al clic del pulsante verrà eseguita la procedura «Add», il cui codice è:

proc Add {} {
    global active_cluster host
    # Determiniamo l'identificatore dell'elemento selezionato
    set id  [.frm_tree.tree selection] 
    # Determiniamo il valore di questo elemento
    set values [.frm_tree.tree item [.frm_tree.tree selection] -values]
    set key [lindex [split $id "::"] 0]
    # a seconda di ciò che abbiamo selezionato, verrà avviata la procedura necessaria
    if {$key eq "" || $key eq "server"} {
        set host [ Add::server ]
        return
    }
    Add::$key .frm_tree.tree $host $values
}

Ecco uno dei vantaggi del tickle: come nome della procedura possiamo passare il valore di una variabile:

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

Ad esempio, se facciamo clic sul server principale e premiamo «+», verrà avviata la procedura Add::server; se sul cluster, verrà avviata Add::cluster e così via (spiegherò più avanti da dove provengono le «chiavi» necessarie). Le procedure elencate disegnano elementi grafici corrispondenti al contesto.

Come avrete già notato, le forme sono simili nello stile — e non è sorprendente, poiché vengono generate da una procedura, precisamente il telaio principale della forma (finestra, pulsanti, immagine, etichetta), nome della procedura. 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
    # etichetta con icona
    ttk::label $win_name.lbl -image $img
    # frame con campi di input
    set frm [ttk::labelframe $win_name.frm -text $lbl -labelanchor nw]
    
    grid columnconfigure $frm 0 -weight 1
    grid rowconfigure $frm 0 -weight 1
    # frame e pulsanti
    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
}

Parametri di chiamata: titolo, nome dell'immagine per l'icona dalla libreria (lib/images.tcl) e un parametro facoltativo nome della finestra (di default .add). Pertanto, utilizzando gli esempi sopra per aggiungere il server principale e il cluster, la chiamata sarà rispettivamente:

AddToplevel "Aggiunta del server principale" server_grey_64

o

AddToplevel "Aggiunta del cluster" cluster_grey_64

Continuando con questi esempi, mostrerò le procedure che visualizzano i dialoghi di aggiunta per il server o il cluster.

Add::server

proc Add::server {} {
    global default
    # visualizza il modulo principale
    set frm [AddToplevel "Aggiunta server principale" server_grey_64]
    # aggiungi etichette e campi di input a questo modulo
    label $frm.lbl_host -text "Indirizzo del server"
    entry  $frm.ent_host
    label $frm.lbl_port -text "Porta"
    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]
    # ridefiniamo il gestore del pulsante
    .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 ""
    }
    # impostiamo le variabili globali ()
    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 "Aggiunta cluster" cluster_grey_64]
    
    label $frm.lbl_host -text "Indirizzo del server principale"
    entry  $frm.ent_host
    label $frm.lbl_port -text "Porta"
    entry $frm.ent_port 
    $frm.ent_port  insert end $default(port)
    label $frm.lbl_name -text "Nome del cluster"
    entry  $frm.ent_name
    label $frm.lbl_secure_connect -text "Connessione sicura"
    ttk::combobox $frm.cb_security_level -textvariable security_level -values $default(security_level)
    label $frm.lbl_expiration_timeout -text "Terminare i processi spenti dopo:"
    entry  $frm.ent_expiration_timeout -textvariable expiration_timeout
    label $frm.lbl_session_fault_tolerance_level -text "Livello di tolleranza ai guasti"
    entry  $frm.ent_session_fault_tolerance_level -textvariable session_fault_tolerance_level
    label $frm.lbl_load_balancing_mode -text "Modalità di bilanciamento del carico"
    ttk::combobox $frm.cb_load_balancing_mode -textvariable load_balancing_mode 
    -values $default(load_balancing_mode)
    label $frm.lbl_errors_count_threshold -text "Soglia di tolleranza degli errori del server, %"
    entry  $frm.ent_errors_count_threshold -textvariable errors_count_threshold
    label $frm.lbl_processes -text "Processi attivi:"
    label $frm.lbl_lifetime_limit -text "Intervallo di riavvio, sec."
    entry  $frm.ent_lifetime_limit -textvariable lifetime_limit
    label $frm.lbl_max_memory_size -text "Dimensione massima della memoria, KB"
    entry  $frm.ent_max_memory_size -textvariable max_memory_size
    label $frm.lbl_max_memory_time_limit -text "Intervallo di superamento della dimensione massima della memoria, sec."
    entry  $frm.ent_max_memory_time_limit -textvariable max_memory_time_limit
    label $frm.lbl_kill_problem_processes -justify left -anchor nw -text "Chiudere forzatamente i processi problematici"
    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
    # ridefinire il gestore
    .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
}

Confrontando il codice di queste procedure, la differenza è evidente a occhio nudo; voglio focalizzarmi sul gestore del pulsante "Ok". In Tk, le proprietà degli elementi grafici possono essere sovrascritte durante l'esecuzione del programma tramite l'opzione configure. Ad esempio, il comando iniziale per il pulsante di output è:

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

Ma nelle nostre maschere, il comando dipende dalla funzionalità richiesta:

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

Nell'esempio sopra, premere il pulsante "Ok" avvia la procedura di aggiunta del cluster.

Qui è utile fare una digressione sul lavoro con gli elementi grafici in Tk: per diversi elementi di input (entry, combobox, checkbutton, ecc.) è stato introdotto un parametro chiamato variabile di testo (textvariable):

entry  $frm.ent_lifetime_limit -textvariable lifetime_limit

Questa variabile è definita nello spazio dei nomi globale e contiene il valore corrente inserito. Cioè, per ottenere il testo inserito nel campo, è sufficiente leggere il valore della relativa variabile (naturalmente a condizione che sia stata definita al momento della creazione dell'elemento).

Il secondo metodo per ottenere il testo inserito (per elementi di tipo entry) è utilizzare il comando get:

.add.frm.ent_name get

Entrambi questi metodi possono essere visti nel codice sopra.

Cliccando su questo pulsante, in questo caso, si avvia la procedura RunCommand con la stringa di comando formata per l'aggiunta del cluster in termini di 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

Ecco il comando principale, che gestisce l'avvio di rac con i parametri necessari, analizzando anche l'output dei comandi in liste e restituendo, se richiesto:

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
    # apriamo un canale in modalità non bloccante
    # $rac - comando con percorso completo
    # $par - chiavi di avvio e opzioni formate
    set pipe [open "|$rac_cmd $par" "r"]
    try {
        set lst ""
        set l ""
        # aggiungiamo l'output del comando alla lista di 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} {
        # Avvio del gestore degli errori
        ErrorParcing $result $options
        return ""
    }
}

Dopo aver inserito i dati del server principale, esso sarà aggiunto all'albero; a questo, nella procedura sopra citata Add:server, risponde il seguente codice:

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

Ora, cliccando sul nome del server nell'albero, otterremo un elenco dei cluster gestiti da quel server, e cliccando sul cluster, otterremo un elenco degli elementi del cluster (server, database informativi, ecc.). Questo è implementato nella procedura TreePress (file lib/function.tcl):

proc TreePress {tree} {
   global host server active_cluster infobase
   # definiamo l'elemento selezionato
    set id  [$tree selection]
   # impostiamo le variabili globali necessarie
    SetGlobalVarFromTreeItems $tree $id
   # Determiniamo la chiave e il valore, ovvero il tipo dell'elemento selezionato
    set values [$tree item $id -values]
    set key [lindex [split $id "::"] 0]
   # e a seconda di ciò che selezioniamo verrà eseguita la procedura corrispondente
   # nello spazio dei nomi Run
    Run::$key $tree $host $values
}

Di conseguenza, per il server principale verrà eseguito Run::server (per il cluster — Run::cluster, per il server di lavoro — Run::work_server e così via). Quindi, il valore della variabile $key è una parte del nome dell'elemento dell'albero, impostata dall'opzione -id.

Notiamo la procedura

Run::server

proc Run::server {tree host values} {
    # otteniamo l'elenco dei cluster del server richiesto
    set lst [RunCommand server::$host "cluster list $host"]
    if {$lst eq ""} {return}
    set l [lindex $lst 0]
    #puts $lst
    # rimuoviamo gli elementi in più dall'elenco
    .frm_work.tree_work delete  [ .frm_work.tree_work children {}]
    # leggiamo l'elenco
    foreach cluster_list $lst {
        # Compiliamo l'elenco con i valori ottenuti
        InsertItemsWorkList $cluster_list
        # elaboriamo l'output (elenco) per aggiungere i dati all'albero
        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]]
            }
        }
    }
    # aggiungiamo i cluster all'albero
    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"
            # aggiungiamo elementi al cluster
            InsertClusterItems $tree $id
        }
    }
    if { [$tree exists "agent_admins::$id"] == 0 } {
        $tree insert "server::$host" end -id "agent_admins::$id" -text "Amministratori" -values "$id"
        #InsertClusterItems $tree $id
    }
}

Questa procedura elabora ciò che è stato ricevuto dal server tramite il comando RunCommand e aggiunge vari elementi all'albero — cluster, diversi nodi principali (database, server di lavoro, sessioni, e così via). Se si osserva con attenzione, si può notare all'interno la chiamata alla procedura InsertItemsWorkList. Questa viene utilizzata per aggiungere elementi all'elenco grafico, elaborando l'output dell'utility della console rac, che era precedentemente restituita in forma di lista nella variabile $lst. Si tratta di un elenco di elenchi, contenente coppie di elementi separate dai due punti.

Ad esempio, l'elenco delle connessioni al 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

Visivamente, apparirà più o meno in questo modo:

Scriviamo un GUI per 1C RAC, o di nuovo su Tcl/Tk.

La procedura sopra menzionata identifica i nomi degli elementi per il titolo e i dati per la compilazione della tabella:

InsertItemsWorkList

proc InsertItemsWorkList {lst} {
    global work_list_row_count
    # impostazione dell'alternanza dei colori per la riga
    if [expr $work_list_row_count % 2] {
        set tag dark
    } else {
        set tag light
    }
    # analisi delle righe in coppie chiave - valore
    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]
        }
    }
     # compilazione della tabella
    .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
    # impostazione degli header
    foreach j $column_list {
        .frm_work.tree_work heading $j -text $j
    }
    incr work_list_row_count
}

Qui, invece del semplice comando [split $str «:»], che suddivide la stringa in elementi separati da «:» e restituisce un elenco, è stata utilizzata un'espressione regolare, poiché alcuni elementi contengono anch'essi i due punti.

La procedura InsertClusterItems (una delle varie simili) aggiunge semplicemente all'albero, per l'elemento richiesto cluster, una lista di elementi figli con gli identificatori corrispondenti.
InsertClusterItems

proc InsertClusterItems {tree id} {
    set parent "cluster::$id"
    $tree insert $parent end -id "infobases::$id" -text "Basi informativi" -values "$id"
    $tree insert $parent end -id "servers::$id" -text "Server di lavoro" -values "$id"
    $tree insert $parent end -id "admins::$id" -text "Amministratori" -values "$id"
    $tree insert $parent end -id "managers::$id" -text "Manager del cluster" -values $id
    $tree insert $parent end -id "processes::$id" -text "Processi di lavoro" -values "workprocess-all"
    $tree insert $parent end -id "sessions::$id" -text "Sessioni" -values "sessions-all"
    $tree insert $parent end -id "locks::$id" -text "Blocchi" -values "blocks-all"
    $tree insert $parent end -id "connections::$id" -text "Connessioni" -values "connections-all"
    $tree insert $parent end -id "profiles::$id" -text "Profili di sicurezza" -values $id
}

Si possono considerare anche due ulteriori varianti di implementazione di tale procedura, dove sarà visibile come ottimizzare ed eliminare i comandi ripetitivi:

In questa procedura, l'aggiunta e il controllo sono affrontati direttamente:

InsertBaseItems

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

Ecco un approccio più corretto:

InsertProfileItems

proc InsertProfileItems {tree id} {
    set parent "profile::$id"
    set lst {
        {dir "Directory virtuali"}
        {com "Classi COM autorizzati"}
        {addin "Componenti esterni"}
        {module "Report e processi esterni"}
        {app "Applicazioni autorizzate"}
        {inet "Risorse 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 differenza tra di loro risiede nell'applicazione di un ciclo, in cui viene eseguita la comando ripetuta (comandi). Quale approccio adottare — è a discrezione dello sviluppatore.

Abbiamo esaminato l'aggiunta di elementi e il recupero dei dati, è ora di soffermarci sulla modifica. Poiché, in genere, per modificare e aggiungere vengono utilizzati gli stessi parametri (l'eccezione è la base informativa), anche i moduli di dialogo sono identici. L'algoritmo per invocare le procedure per l'aggiunta è il seguente:

Add::$key->AddToplevel

E per la modifica così:

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

Prendiamo come esempio la modifica di un cluster, cioè cliccando sul nome del cluster nell'albero, premiamo il pulsante di modifica nella barra degli strumenti (la matita) e sullo schermo verrà visualizzato il modulo corrispondente:

Scriviamo un GUI per 1C RAC, o di nuovo su 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 ""
    }
    # disegniamo il modulo per il cluster
    set frm [Add::cluster $tree $host $values]
    # cambiamo il testo sull'etichetta
    $frm configure -text "Modifica del cluster"
    
    set active_cluster $values
    # otteniamo i dati per il cluster selezionato
    set lst [RunCommand cluster::$values "cluster info --cluster=$active_cluster $host"]
    # riempiamo i campi
    FormFieldsDataInsert $frm $lst
    # disabilitiamo i campi che non possono essere modificati
    $frm.ent_host configure -state disable
    $frm.ent_port configure -state disable
    # rimappiamo il gestore
    .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
    }
}

Dai commenti nel codice, in generale, è tutto chiaro, tranne per il fatto che il codice del gestore del pulsante è stato sovrascritto e c'è una procedura FormFieldsDataInsert che riempie i campi con i dati e inizializza le variabili:

FormFieldsDataInsert

proc FormFieldsDataInsert {frm lst} {
    foreach i [lindex $lst 0] {
        # otteniamo la lista di parametri e valori
        if [regexp -nocase -all -- {(D+)(s*?|)(:)(s*?|)(.*)} $i match param v2 v3 v4 value] {
            # modifichiamo i caratteri
            regsub -all -- "-" [string trim $param] "_" entry_name
            # riempiamo con i dati
            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 """]
            }
            # per le checkbox modifichiamo i valori
            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
                }
            }
        }
    }
}

In questa procedura è emerso un ulteriore vantaggio di tcl: come nomi di variabili vengono utilizzati i valori di altre variabili. Cioè, per automatizzare il completamento dei moduli e l'inizializzazione delle variabili, i nomi dei campi e delle variabili corrispondono alle chiavi della riga di comando dell'utility rac e ai nomi dei parametri di output dei comandi, con alcune eccezioni: il trattino è sostituito da un sottolineato. Ad esempio, scheduled-jobs-deny corrisponde al campo ent_scheduled_jobs_deny e alla variabile scheduled_jobs_deny.

I moduli di aggiunta e modifica possono differire nella composizione dei campi, ad esempio, lavorando con la base informativa:

Aggiunta IB

Scriviamo un GUI per 1C RAC, o di nuovo su Tcl/Tk.

Modifica IB

Scriviamo un GUI per 1C RAC, o di nuovo su Tcl/Tk.

Nella procedura di modifica Edit::infobase vengono aggiunti alla forma i campi richiesti, il codice è esteso quindi non lo fornisco qui.

Procedure simili sono state implementate per l'aggiunta, la modifica e la cancellazione di altri elementi.

Poiché il funzionamento dell'utilità implica un numero illimitato di server, cluster, basi di dati, ecc., sono state introdotte diverse variabili globali per determinare a quale cluster appartiene ciascun server o DB. In altre parole, la procedura esegue una scansione ricorsiva di tutti gli elementi genitori e imposta le variabili:

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

Il cluster 1C consente di operare sia con che senza autorizzazione. Esistono due tipi di amministratori: l'amministratore dell'agente del cluster e l'amministratore del cluster. Pertanto, per un funzionamento corretto, sono state introdotte altre 4 variabili globali contenenti il login e la password dell'amministratore. Cioè, se nel cluster è presente un account amministratore, verrà visualizzata una finestra di dialogo per l'inserimento di login e password, i dati saranno memorizzati in memoria e verranno utilizzati in ogni comando per il relativo cluster.

Questo è gestito dalla procedura di gestione degli errori.

ErrorParcing

proc ErrorParcing {err opt} {
    global cluster_user cluster_pwd agent_user agent_pwd
        switch -regexp -- $err {
        "Il amministratore del cluster non è autenticato" {
            AuthorisationDialog "Amministratore del 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'amministratore del server centrale non è autenticato" {
            AuthorisationDialog "Amministratore dell'agente del 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 "Amministratore del 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 "Amministratore dell'agente del 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"
        }
    }
}

Cioè, a seconda di ciò che restituisce il comando, ci sarà anche una reazione corrispondente.

Attualmente la funzionalità è implementata per circa il 95%, resta da implementare il lavoro con i profili di sicurezza e fare dei test =). Questo è tutto. Mi scuso per la narrazione affrettata.

Il codice, come al solito, è disponibile qui.

Aggiornamento: Ho completato il lavoro con i profili di sicurezza. Ora la funzionalità è implementata al 100%.

Aggiornamento 2: aggiunta la localizzazione in inglese e russo, verificato il funzionamento su Windows 7
Scriviamo un GUI per 1C RAC, o di nuovo su Tcl/Tk.

Fonte: habr.com

Acquista hosting affidabile per siti web con protezione DDoS, VPS VDS server 🔥 Acquista hosting affidabile per siti web con protezione DDoS, VPS VDS server | ProHoster