/usr/share/astk/tools.tcl

#########################################################################
# COPYRIGHT (C) 2003         EDF R&D              WWW.CODE-ASTER.ORG    #
#                                                                       #
# THIS PROGRAM IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR         #
# MODIFY IT UNDER THE TERMS OF THE GNU GENERAL PUBLIC LICENSE AS        #
# PUBLISHED BY THE FREE SOFTWARE FOUNDATION; EITHER VERSION 2 OF THE    #
# LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION.                       #
# THIS PROGRAM IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL,       #
# BUT WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF        #
# MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE GNU      #
# GENERAL PUBLIC LICENSE FOR MORE DETAILS.                              #
#                                                                       #
# YOU SHOULD HAVE RECEIVED A COPY OF THE GNU GENERAL PUBLIC LICENSE     #
# ALONG WITH THIS PROGRAM; IF NOT, WRITE TO : EDF R&D CODE_ASTER,       #
#    1 AVENUE DU GENERAL DE GAULLE, 92141 CLAMART CEDEX, FRANCE.        #
#########################################################################

# $Id: tools.tcl 3526 2008-09-26 07:14:26Z courtois $

# verifications avant lancement
# si sortie=1, on quitte le programme immediatement apres
#################################################################
proc check_conf { sortie } {
   set nberr 0
# vérifie le nom de la machine
   check_nom_complet
# vérifie le display
   check_display

# vérifie : ps -p NUM_PROCESS
# on ne connait pas de NUM_PROCESS en cours, on teste avec -o,
# car le ps qui n'accepte pas -p, n'accepte pas non plus -o...
   set possib { ps /bin/ps /usr/bin/ps }
   for {set i 0} {$i < [llength $possib]} {incr i} {
      set astk::cmd(ps) [lindex $possib $i]
      if { $astk::platform == "unix" } {
         set cmd "exec $astk::cmd(shell_cmd) \"$astk::cmd(ps) -o pid 1> /dev/null 2>&1 ; echo EXIT_CODE=$?\""
      } else {
         set cmd "exec $astk::cmd(shell_cmd) \"$astk::cmd(ps) -o pid 1> NUL 2>&1; echo EXIT_CODE=$?\""
      }
      catch { eval $cmd } out
      if { [regexp -- {EXIT_CODE=0.*} $out mat1] == 0 } {
         set astk::cmd(ps) -1
      } else {
         break
      }
   }
   if { $astk::cmd(ps) == -1 } {
      ashare::mess erreur 23 ps
      incr nberr
   }
   ashare::mess info 26 ps $astk::cmd(ps)

   if { $sortie } {
# vérifie que les commandes distantes fonctionnent
      set proto $astk::config(-1,remote_shell_protocol)
      if { $proto == "" } {
          set proto SSH
      }
      init_config
      if { $proto == "RSH" } {
         set cmd "rsh -n -l $astk::config(-1,login) $astk::config(-1,nom_complet) echo hello"
         set iderr 25
      } elseif { $proto == "SSH" } {
         set cmd "ssh -n -l $astk::config(-1,login) $astk::config(-1,nom_complet) echo hello"
         set iderr 56
      } else {
         ashare::mess erreur 49 $proto
         # le premier appel à rexec_cmd échouera
         cmd="echo ERROR"
      }
      for {set i 0} {$i < $astk::config(nb_serv)} {incr i} {
         if { $astk::config($i,etat) == "on" } {
            ashare::mess info 29 $astk::config(-1,nom_complet) $astk::config($i,nom_complet)
            set iret [ashare::rexec_cmd $i astk::config "echo hello" "" 0 out .]
            if { $iret == 0 && $out == "hello" } {
               ashare::mess info 30
               # test le sens inverse
               ashare::mess info 29 $astk::config($i,nom_complet) $astk::config(-1,nom_complet)
               set jret [ashare::rexec_cmd $i astk::config $cmd "" 0 out .]
               if { $jret == 0 && $out == "hello" } {
                  ashare::mess info 30
               } else {
                  ashare::mess erreur $iderr $astk::config(-1,login) $astk::config(-1,nom_complet) $astk::config($i,login) $astk::config($i,nom_complet) $out
                  incr nberr
               }
            } else {
               ashare::mess erreur $iderr $astk::config($i,login) $astk::config($i,nom_complet) $astk::config(-1,login) $astk::config(-1,nom_complet) $out
               incr nberr
            }
         }
      }
   }

# quitte ?
   ashare::mess "info" 11 $nberr
   if { $sortie || $nberr > 0 } {
      ashare::my_exit 1
   }
}

# info sur le DISPLAY, warning si :0 ou :0.0 ou ajouter uname -n devant
#################################################################
proc check_display { } {
   if { [string trim $astk::config(-1,forced_display)] != "" } {
      set ashare::DISPLAY $astk::config(-1,forced_display)
   } else {
      if { [regexp -- {^(:[0-9]+[\.0-9]*)} $ashare::DISPLAY mat1 displ] } {
      # || $astk::config(-1,isdhcp) == 1
         set ashare::DISPLAY "$astk::config(-1,nom_complet)$displ"
      }
      # warning si pas de nom de domaine
      if { [regexp -- {.*\..*\..*:.*} $ashare::DISPLAY] == 0 } {
         if { $astk::config(-1,nom_domaine) == "" } {
            ashare::mess info 27
         } else {
            regexp -- {(.*):(.*)} $ashare::DISPLAY mat1 hh dd
            set ashare::DISPLAY "$hh.$astk::config(-1,nom_domaine):$dd"
         }
      }
   }
   ashare::mess info 23 $ashare::DISPLAY
}

# verif le nom ou IP de la machine cliente
#################################################################
proc check_nom_complet { } {
   global tcl_platform
   global listadr
   global env

   # faut-il passer en mode DHCP
   if { $astk::config(-1,nom_complet) == "" || $astk::config(-1,isdhcp) == 1 } {
      set astk::config(-1,isdhcp) 1
      ashare::mess info 35
      # on essaie de la récupérer sous Linux, Solaris, Tru64
      set cmd ""
      if { $tcl_platform(os) == "Linux" } {
         set cmd "exec /sbin/ifconfig | sed -n -e \"s/^.*ad.*r://g\" -n -e \"s/ *Bcast.*//p\""
         # fonction cachée !
         catch {
            if { $env(ASTK_DHCP_PPP) == "YES" } {
               set cmd "exec /sbin/ifconfig | sed -n -e \"s/^.*ad.*r://g\" -n -e \"s/ *P-t-P.*//p\""
            }
         }
      } elseif { $tcl_platform(os) == "SunOS" || $tcl_platform(os) == "OSF1" } {
         set cmd "exec /sbin/ifconfig -a | sed -n -e \"s/^.*inet *//g\" -n -e \"s/ *netmask.* broadcast.*//p\""
      }
      if { $cmd != "" } {
         catch { eval $cmd } out
         # ...si plusieurs, on prend la première !
         set ladr0 [lindex [split $out] 0]
         # verif
         set listadr [list]
         set ilast -1
         for { set i 0 } { $i < [llength $ladr0] } { incr i } {
           if { [regexp -- { *([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+) *} [lindex $ladr0 $i] mat1 net] } {
               lappend listadr $net
               if { $net == $astk::config(-1,ipdhcp) } {
                  set ilast $i
               }
            }
         }
         if { $ilast == -1 && $astk::config(-1,ipdhcp) != "" } {
            lappend listadr $astk::config(-1,ipdhcp)
         }
         if { $ashare::show_dialog == 1 } {
            choixIP $ilast
            tkwait window .f_choixIP
         }
      }
      # sinon dire qu'il faut la saisir dans Configuration/Interface
      if { $astk::config(-1,nom_complet) == "" } {
         set msg [ashare::mess info 36]
         if { $ashare::show_dialog == 1 } {
            tk_messageBox -title [ashare::mess ihm 138] -message $msg -type ok
         }
      } else {
         ashare::mess info 37 $astk::config(-1,nom_complet)
      }
   } else {
      if { [regexp -- {\.(.+)} $astk::config(-1,nom_complet) mat1 suff] } {
      # le nom_complet contient déjà un domaine
         if { $astk::config(-1,nom_domaine) != "" && $suff != $astk::config(-1,nom_domaine) } {
            ashare::mess info 31 $suff $astk::config(-1,nom_domaine)
         } else {
            set astk::config(-1,nom_domaine) $suff
         }
      } else {
      # le nom_complet sans domaine, on l'ajoute
         if { $astk::config(-1,nom_domaine) == "" } {
            if { $ashare::show_dialog == 1 } {
               set msg [ashare::mess info 32]
               tk_messageBox -title [ashare::mess ihm 138] -message $msg -type ok
            }
         } else {
            append astk::config(-1,nom_complet) "." $astk::config(-1,nom_domaine)
            regsub -all -- {\.+} $astk::config(-1,nom_complet) "." astk::config(-1,nom_complet)
         }
      }
   }
   ashare::mess info 41 $astk::config(-1,nom_complet)
}

# convertit astk::profil(temps) de "00:00:00" en secondes
# 00:00 correspond à mm:ss
# 00 à ss
# si l'expression est invalide, on renvoie 0
#################################################################
proc conv_tps { var } {
   set val 0
   # ne pas commencer par 08 (octal)
   regsub -- {^0} $var "" var
   if {[regexp {^[1-9]+} $var] != 1} {
      set var "0$var"
   }

   if {[regexp {^[ ]*([0-9]+)[ ]*:[ ]*([0-9]+)[ ]*:[ ]*([0-9]+)[ ]*} $var phr hh mm ss] == 1} {
      set val [ expr $ss+($mm*60)+($hh*3600) ]
   } elseif {[regexp {^[ ]*([0-9]+)[ ]*:[ ]*([0-9]+)[ ]*} $var phr mm ss] == 1} {
      set val [ expr $ss+($mm*60) ]
   } elseif {[regexp {^[ ]*([0-9]+)[ ]*} $var phr ss] == 1} {
      set val [ expr $ss ]
   } else {
      if { $ashare::dbg >= 2 } {
         ashare::log "<DEBUG> (conv_tps) Format incorrect pour $var"
      }
      return 0
   }
   return $val
}

# Paramètre spécifique Salome
#################################################################
proc mod_ORBInitRef { ORBInitRefValue } {
   set repl ""
   set astk::profil(option,ORBInitRef) 1
   append repl " -ORBInitRef"
   set astk::profil(opt_val,ORBInitRef) $ORBInitRefValue
   append repl " $ORBInitRefValue"
   append astk::profil(args_fixe) "$repl"
   regsub {^[ ]*} $astk::profil(args_fixe) "" astk::profil(args_fixe)
   regsub {[ ]*$} $astk::profil(args_fixe) "" astk::profil(args_fixe)
}

# traitement des arguments
#################################################################
proc traite_argv { } {
    global argc argv
    for {set i 0} {$i < $argc} {incr i} {
        switch -exact -- [lindex $argv $i] {
            -h -
         --help {
                set ashare::fen_log 0
            ashare::mess "info" 10
            ashare::my_exit 1
            }
            -g -
         --debug {
                set ashare::dbg 1
                if { $i < [ expr $argc - 1 ] } {
                    incr i
                    if { [string equal [string index [lindex $argv $i] 0] - ] } {
                        incr i -1
                    } else {
                        set ashare::dbg [lindex $argv $i]
                  set astk::config(-1,dbglevel) $ashare::dbg
                    }

                }
            }
            --serv {
                if { $i < [ expr $argc - 1 ] } {
                    incr i
               set astk::ihm(serv_ini) [lindex $argv $i]
                }
            }
            --profil {
                if { $i < [ expr $argc - 1 ] } {
                    incr i
               set astk::ihm(profil_ini) [lindex $argv $i]
               if { [string index $astk::ihm(profil_ini) 0] != "/" } {
                  set astk::ihm(profil_ini) [file join [pwd] $astk::ihm(profil_ini)]
                  regsub -all {/\./} $astk::ihm(profil_ini) "" astk::ihm(profil_ini)
               }
                }
            }
            --import {
                if { $i < [ expr $argc - 1 ] } {
                    incr i
               set astk::ihm(export_ini) [lindex $argv $i]
               if { [string index $astk::ihm(export_ini) 0] != "/" } {
                  set astk::ihm(export_ini) [file join [pwd] $astk::ihm(export_ini)]
                  regsub -all {/\./} $astk::ihm(export_ini) "" astk::ihm(export_ini)
               }
                }
            }
         --agla {
                if { $i < [ expr $argc - 1 ] } {
                    incr i
                    if { [file exists [lindex $argv $i]] } {
                        set astk::agla(fic_conf) [lindex $argv $i]
                    } else {
                        ashare::mess "erreur" 8 [lindex $argv $i]
                    }
                }
         }
            -nb {
            set astk::ihm(style,couleur) "nb"
            }
            --check {
                set ashare::fen_log 0
                set astk::check_quit 1
            }
            --norecup {
                set astk::recup 0
            }
            --stdout {
                set ashare::fen_log 0
            destroy $astk::ihm(log)
            }
            --version {
                ashare::my_exit 0
            }
         --no-initial-warnings {
            set ashare::noinitwarn 1
         }
         --no-splash {
            set ashare::splash_screen 0
         }
            --stand-alone -
         --from_salome {
            regsub -- "--" [lindex $argv $i] "" orig
                set ashare::origine $orig
            if { $i < [ expr $argc - 1 ] } {
               incr i
               set ashare::ORBInitRef [lindex $argv $i]
               #mod_ORBInitRef [lindex $argv $i]
            }
            }
         --rcdir {
            if { $i < [ expr $argc - 1 ] } {
               incr i
            }
         }
         default {
            ashare::mess "erreur" 11 [lindex $argv $i]
         }
        }
    }
}

# ignloc=1 : ignore la config locale, (-1,...)
#################################################################
proc copie_tabl { conf_src conf_dest {ignloc 0} } {
   upvar $conf_src src
   upvar $conf_dest dest
   set nbv 0
   if { $ashare::dbg >= 5 } {
      ashare::log "<DEBUG> (copie_tabl) Copie les valeurs de $conf_src dans $conf_dest" }
   set lmv [array get src]
   if { $ignloc != 1 } {
      catch {array unset dest}
   }
   set nbl [expr [llength $lmv] / 2]
   for {set i 0} {$i < $nbl} {incr i} {
      set k  [expr $i * 2]
      set k1 [expr $k + 1]
      # ne pas prendre la config "locale"
      if { $ignloc == 0 || [regexp {^\-1} [lindex $lmv $k] mat1] != 1 } {
         set dest([lindex $lmv $k]) [lindex $lmv $k1]
         incr nbv
      }
   }
   return $nbv
}

# dialogue de choix de l'adresse IP
#################################################################
proc choixIP { ilast } {
   global listadr manIP old_pref

   set fen .f_choixIP
   set tit [ashare::mess ihm 350]
   catch {destroy $fen}
   toplevel $fen
   wm title $fen $tit
   grab set $fen

#  texte
   pack [frame $fen.txt -relief solid -bd 0] -anchor c
   label $fen.txt.lbl -font $astk::ihm(font,txt) -text [ashare::mess ihm 351] -anchor w
   pack $fen.txt.lbl -padx 20 -pady 10 -side left

#  zone IP
   pack [frame $fen.ip -relief solid -bd 0] -padx 15 -pady 10 -anchor c -fill both -expand 1
      grid [frame $fen.ip.f -relief raised -bd 0] -row 0 -column 0 -sticky nsew -padx 15 -pady 10
      grid [frame $fen.ip.man -relief raised -bd 0] -row 1 -column 0 -sticky sew -padx 15 -pady 10
      grid [frame $fen.ip.valid -relief raised -bd 0] -row 0 -column 1 -rowspan 2 -sticky ns -padx 15 -pady 10

#  info
   set lab $astk::config(-1,ipdhcp)
   # si modif des préférences en cours
   catch {set lab $old_pref(-1,ipdhcp)}
   if { $astk::config(-1,ipdhcp) != "" } {
      pack [frame $fen.st -relief raised -bd 0] -anchor c -fill x -expand 1
      label $fen.st.txt -font $astk::ihm(font,val) -text [ashare::mess ihm 353 $lab] -anchor w -relief sunken
      pack $fen.st.txt -fill x -anchor w -expand 1
   }

   listbox $fen.ip.f.lst -yscrollcommand "$fen.ip.f.scrolly set" \
      -selectmode single -height 4 -width 15 -font $astk::ihm(font,zonfix) -setgrid true -bg white -listvar listadr
   scrollbar $fen.ip.f.scrolly -command "$fen.ip.f.lst yview"
   pack $fen.ip.f.scrolly -side right  -fill y
   pack $fen.ip.f.lst -expand yes -fill both

   set manIP ""
   entry $fen.ip.man.ent -font $astk::ihm(font,zonfix) -textvariable manIP -width 15
   pack $fen.ip.man.ent -fill x -expand 1

   button $fen.ip.valid.ok -font $astk::ihm(font,labbout) -text "Ok" \
      -bg $astk::ihm(couleur,valid) \
      -command "acceptIP $fen"
   pack $fen.ip.valid.ok -side left -padx 10 -pady 5

   # selection par defaut
   if { $ilast > -1 } {
      $fen.ip.f.lst selection set $ilast
   }
   # events
   event add <<Modif>> <Key>
   event add <<Modif>> <Button>
   bind $fen.ip.man.ent <<Modif>> "$fen.ip.f.lst selection clear 0"
   wm protocol $fen WM_DELETE_WINDOW "$fen.ip.valid.ok invoke"
}

# valide le choix de l'adresse IP
#################################################################
proc acceptIP { fen } {
   global listadr manIP

   set indsel [$fen.ip.f.lst curselection]
   set ip ""
   if { $indsel != "" } {
      set ip [lindex $listadr $indsel]
   } elseif { [regexp -- { *([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+) *} $manIP mat1 ip] == 0 } {
      set msg [ashare::mess ihm 352]
      tk_messageBox -title [ashare::mess ihm 138] -message $msg -type ok
   }
   if { $ip != "" } {
      set astk::config(-1,nom_complet) $ip
      set astk::config(-1,ipdhcp) $ip
      ashare::save_prefs
      grab release $fen
      destroy $fen
   }
}

# valide une valeur oui/non
#################################################################
proc in_yes_values { val } {
    set iret 0
    set val [string tolower $val]
    if { $val == "oui" || $val == "yes" } {
        set iret 1
    }
    return $iret
}

proc in_no_values { val } {
    return [expr 1 - [in_yes_values $val] ]
}
code-aster-gui 1.13.1-2 / usr / share / astk / tools.tcl
