code-aster-gui 1.13.1-2 / usr / share / astk / init_env.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: init_env.tcl 3255 2008-04-10 17:13:17Z courtois $

#################################################################
proc init_env { {parent ""} } {
   # lecture de la configuration des serveurs
   init_config

   for {set i 0} {$i < $astk::config(nb_serv)} {incr i} {
      if { $astk::recup && $astk::config($i,recup) == "auto"
        && $astk::config($i,etat) == "on" } {
         # récupération automatique de la config si plus de n jours
         set hh [clock seconds]
         set lrec [clock scan $astk::config($i,last_recup)]
         set nbj [expr ($hh-$lrec)/24/3600]
         if { $nbj > 30 || $astk::config($i,islocal) == "oui"} {
            recup_info $parent $i
         }
      }
   }
   # nécessaire s'il y a eu une erreur + last_recup + nouveaux versions/noeuds
   ashare::save_options

   # fournit la liste à l'ihm
   set astk::profil(noeud) "-"
   cree_liste_machines
   # récupère des valeurs pour l'ihm
   check_config

# serveur de profil_ini
   if { $astk::ihm(serv_ini) != "" } {
      set astk::ihm(serv_ini) $astk::inv(serv,$astk::ihm(serv_ini))
   }

# initialisation des outils et imprimantes
   init_outils
   init_print

# derniers profils ouverts
   lire_prof
   cohe_prof
}

#################################################################
proc init_config {} {
   set fich $astk::fic_serveurs
   set iret [ ashare::lire_options $fich astk::config ]
   if { $ashare::dbg >= 4 } {
      ashare::log "<DEBUG> (lire_options) retour : $iret"
   }
   if { $iret != 0 } {
      set fich [file join $ashare::astkrc_ref config_serveurs]
      if { $iret == "FICH_NON_TROUVE" } {
         ashare::mess "info" 4 $astk::fic_serveurs
         ashare::lire_options $fich astk::config
      } elseif { $iret == "PB_astkrc_version" } {
         ashare::mess "erreur" 4 $astk::fic_serveurs.old
         file rename -force $astk::fic_serveurs $astk::fic_serveurs.old
         ashare::lire_options $fich astk::config
      } else {
         ashare::mess "erreur" 1 "ashare::lire_options"
         ashare::my_exit 4
      }
   } else {
      # migration to 1.8.0
      set ichg 0
      for {set i 0} {$i < $astk::config(nb_serv)} {incr i} {
         set prev $astk::config($i,rep_serv)
         if { [string compare $astk::config($i,asrun_vers) "01.08.00"] < 0 } {
            regsub -- "/ASTK/ASTK_SERV/bin" $astk::config($i,rep_serv) "/ASTK/ASTK_SERV" astk::config($i,rep_serv)
         } else {
            regsub -- "/ASTK/ASTK_SERV/bin" $astk::config($i,rep_serv) "" astk::config($i,rep_serv)
            regsub -- "/ASTK/ASTK_SERV" $astk::config($i,rep_serv) "" astk::config($i,rep_serv)
         }
         if { $prev != $astk::config($i,rep_serv) } {
            if { $ichg == 0 } {
               ashare::log "<INFO> [ashare::mess ihm 388]"
            }
            set ichg 1
            ashare::log [ashare::mess ihm 389 $astk::config($i,nom) $astk::config($i,nom_complet) $astk::config($i,asrun_vers) $prev $astk::config($i,rep_serv)]
         }
      }
      if { $ichg } {
         tk_messageBox -title [ashare::mess ihm 138] -message [ashare::mess ihm 388] -type ok
      }
   }
}

# Utilise certaines de la configuration des serveurs pour l'ihm
#################################################################
proc check_config {} {
    # reinit batch queue groups
    update_opt classe {} "REINIT"
    for {set i 0} {$i < $astk::config(nb_serv)} {incr i} {
        if { $astk::config($i,batch) != "non" } {
            # batch queue groups
            update_opt classe $astk::config($i,batch_queue_group) "APPEND"
        }
    }
}


# Récupère les infos sur le serveur
#################################################################
proc recup_info { parent serv } {
   global warn_seen
   # init warn_seen
   set val 0
   catch { set val $warn_seen($serv) }
   set warn_seen($serv) $val
   set iret -1
   ashare::mess info 12 $astk::config($serv,nom)
   ShowSplashInfo [ashare::mess "ihm" 368 $astk::config($serv,nom_complet)]
# préparation de la ligne de commande à exécuter
   set ftmp [get_tmpname .info_export]
   set idexp [open $ftmp w]
   write_server_infos $idexp $serv
   close $idexp
   set lcmd [file join $ashare::prefix "usr/bin" as_run]
   append lcmd " --proxy --info --schema=[get_schema $serv info] $ftmp"
   append lcmd [ashare::get_glob_args]
# on n'ajoute pas les protocoles en argument :
# - car as_info ne fait pas de rcp/rsh
# - pour assurer la comptabilité (au moins récupérer le numéro de version)
#  execution
   set logprogress "progress"
   if { $ashare::appli == "bsf" } {
       set logprogress "None"
   }
   set iret [ashare::rexec_cmd -1 astk::config $lcmd "" 0 out $parent $logprogress]
   set jret $iret
   if { $jret == 0 } {
      if { $ashare::dbg >= 5 } {
         ashare::log "<DEBUG> (recup_info) output as_info = $out"
      }
      # decodage du retour
      if { [regexp {@PARAM@(.*)@FINPARAM@}       $out mat1 lpar] != 1 ||
           [regexp {@VERSIONS@(.*)@FINVERSIONS@} $out mat1 lver] != 1 ||
           [regexp {@NOEUDS@(.*)@FINNOEUDS@}     $out mat1 lnod] != 1 } {
         set jret 1
      } else {
      # paramètres
         set nocc [expr [llength $lpar] / 3]
         for {set k 0} {$k < $nocc } {incr k} {
            regsub {^[ ]*} [lindex $lpar [expr $k * 3]] "" mc
            regsub {[ ]*$} $mc "" mc
            regsub {^[ ]*} [lindex $lpar [expr $k * 3 + 2]] "" val
            regsub {[ ]*$} $val "" val
# glut pour le temps
            if { [regexp {tpsmax} $mc mat1] == 1 } {
               set val [conv_tps $val]
            }
            set astk::config($serv,$mc) $val
            if { $ashare::dbg >= 5 } {
               ashare::log "<DEBUG> (recup_info) astk::config($serv,$mc) = $val"
            }
         }
      # versions
         array unset astk::config($serv,vers,*)
         set astk::config($serv,nb_vers) 0
         set nocc [expr [llength $lver] / 3]
         for {set k 0} {$k < $nocc } {incr k} {
            regsub {^[ ]*} [lindex $lver [expr $k * 3 + 2]] "" val
            regsub {[ ]*$} $val "" val
            set astk::config($serv,vers,$astk::config($serv,nb_vers)) $val
            if { $ashare::dbg >= 5 } {
               ashare::log "<DEBUG> (recup_info) astk::config($serv,vers,$astk::config($serv,nb_vers)) = $val"
            }
            incr astk::config($serv,nb_vers)
         }
      # noeuds
         array unset astk::config($serv,noeud,*)
         set astk::config($serv,nb_noeud) 0
         set nocc [expr [llength $lnod] / 3]
         for {set k 0} {$k < $nocc } {incr k} {
            regsub {^[ ]*} [lindex $lnod [expr $k * 3 + 2]] "" val
            regsub {[ ]*$} $val "" val
            set astk::config($serv,noeud,$astk::config($serv,nb_noeud)) $val
            if { $ashare::dbg >= 5 } {
               ashare::log "<DEBUG> (recup_info) astk::config($serv,noeud,$astk::config($serv,nb_noeud)) = $val"
            }
            incr astk::config($serv,nb_noeud)
         }
      # machine de référence ?
         set astk::config($serv,mach_ref) "non"
         if { [regexp {@MACHREF@(.*)@FINMACHREF@} $out mat1 lmach] } {
            set astk::config($serv,mach_ref) "oui"
            if { [regexp {@REX_URL@\n(.*)\n@FINREX_URL@} $out mat1 rex_url] } {
               set astk::agla(rex_url) $rex_url
            }
            if { [regexp {@REX_REPFICH@\n(.*)\n@FINREX_REPFICH@} $out mat1 rep_rex] } {
               set astk::agla(rep_rex) $rep_rex
            }
            if { [regexp {@ROLE@\n(.*)\n@FINROLE@} $out mat1 lrole] } {
               set astk::agla(instance) [split $lrole]
            }
            if { [regexp {@INFOID@\n(.*)\n@FININFOID@} $out mat1 ldet] } {
               set astk::agla(infoid) [split $ldet]
            }
            if { [regexp {@MAIL_ATA@\n(.*)\n@FINMAIL_ATA@} $out mat1 mail_ata] } {
               set astk::agla(mail_ata) $mail_ata
            }
         }
      # version des services
         set client_vers [get_num_vers $astk::astk_version]
         regexp {@SERV_VERS@\n(.*)\n@FINSERV_VERS@} $out mat1 tmp_serv_vers
         set serv_vers   [get_num_vers $tmp_serv_vers]
         set astk::config($serv,asrun_vers) $serv_vers
         set icmp [string compare $serv_vers $client_vers]
         if { $ashare::show_dialog == 1 && $warn_seen($serv) != 1 } {
            if { $icmp < 0 } {
               tk_messageBox -title [ashare::mess ihm 138] -message [ashare::mess ihm 233 $astk::config($serv,nom) $serv_vers $client_vers] -type ok -icon info
            } elseif { $icmp > 0 } {
               tk_messageBox -title [ashare::mess ihm 138] -message [ashare::mess ihm 234 $astk::config($serv,nom) $serv_vers $client_vers] -type ok -icon info
            }
         }
      # message of the day
         #$astk::config($serv,nom)
         if { [regexp {@MOTD@\n(.*)\n@FINMOTD@} $out mat1 motd] } {
            set motd [string trim $motd]
            if { $motd != "" && $ashare::show_dialog == 1 && $warn_seen($serv) != 1 } {
               ashare::fen_info .fen_motd [ashare::mess ihm 114] [ashare::mess ihm 113 $astk::config($serv,nom)] $motd
            }
         }
      # liste des groupes de classes batch
         if { [regexp {@QUEUE_INFO@\n(.*)\n@FINQUEUE_INFO@} $out mat1 strtmp] } {
            set astk::config($serv,batch_queue_group) $strtmp
            update_opt classe $strtmp "APPEND"
         }
      # mise à jour de last_recup (ATTENTION : format anglosaxon)
         set hh [clock format [clock seconds] -format "%m/%d/%Y"]
         set astk::config($serv,last_recup) $hh
         set warn_seen($serv) 1
      }
   } else {
      ashare::mess "erreur" 3 "as_info" $iret $out
   }
   ashare::mess "info" 13
   ShowSplashInfo [ashare::mess "ihm" 367]
   return $jret
}

# Retourne un numéro de version de la format NN.NN.NN
#################################################################
proc get_num_vers { vers_in } {
   set vers_out "00.00.00"
   if { [regexp {([0-9a-z]+)\.([0-9a-z]+)\.([0-9a-z]+)} $vers_in mat1 i1 i2 i3] } {
      set vers_out [format "%02s.%02s.%02s" $i1 $i2 $i3]
   }
   return $vers_out
}

# Lecture de la liste des derniers profils ouverts
#################################################################
proc lire_prof { } {
   set fich "$astk::fic_prof"
   set astk::ihm(prof,nb) 0
   if { $ashare::dbg >= 4 } {
      ashare::log "<DEBUG> (lire_prof) Lecture $fich" }

   if { [ file exists $fich ] == 0 } {
      return 0
   }
   set iret [ ashare::lire_mc_val $fich mots vale nlu ]
   if { $iret != 0 } {
      return $iret }

   # phase de vérif
   # mots-clés reconnus
   set mots_cles $ashare::mots(MCF_prof)
   # mots-clés sous le mot-clé facteur
   set mots_smcf $ashare::mots(SSF_prof)
   append mots_cles $mots_smcf
   # les mots-clés sont obligatoires
   set pmcs [llength $mots_smcf]
   set pmcf [expr [llength $mots_cles] - $pmcs - 1]
   for { set k 0 } { $k < [ llength $mots_cles ] } { incr k } {
      set mcs [lindex $mots_cles $k]
      set pres($mcs) 0
   }

   set nbmcf -1
   set nberr 0
   for {set j 1} {$j <= $nlu} {incr j} {
      #astkrc_version
      if { $mots($j) == "astkrc_version" } {
         if { $vale($j) != "$ashare::astkrc_version" } {
            ashare::mess "erreur" 2 $fich
            return PB_astkrc_version
         }
      } else {
         set iv [lsearch -exact $mots_cles $mots($j)]
         if { $iv < 0 } {
            ashare::mess "erreur" 5 $mots($j)
            incr nberr
         } else {
            incr pres($mots($j))
            if { $mots($j) == "profil" } {
               incr nbmcf
               set astk::ihm(prof,$nbmcf) $vale($j)
            } else {
               set astk::ihm(prof,$mots($j),$nbmcf) $vale($j)
            }
         }
      }
   }
   if { $nbmcf < 0 } {
      ashare::mess "erreur" 7 "profil" "profile" ""
   }
   incr nbmcf
   set astk::ihm(prof,nb) $nbmcf
   # est-ce qu'il manque un mot-clé ?
   set sum 0
   for { set k 0 } { $k < [ llength $mots_cles ] } { incr k } {
      set mcs [lindex $mots_cles $k]
      set sum [expr $sum + $pres($mcs)]
   }
   if { $sum != [expr $pmcf+($nbmcf*($pmcs+1))] } {
      ashare::mess "erreur" 6 "?" "?" $fich ""
      incr nberr
   }
   if { $nberr > 0 } {
      ashare::mess "erreur" 8 $fich
      ashare::my_exit 4
   }
   if { $ashare::dbg >= 4 } {
      ashare::log "<DEBUG> (lire_prof) $nbmcf profils" }
   return 0
}

# construit la liste des noeuds accessibles par l'ihm : ihm(lnoeud,$i)
# et les tableaux inverses
#################################################################
proc cree_liste_machines { } {
   set pastrouve 1
   set i 0
   set astk::ihm(lnoeud,$i) "-"
   set astk::inv(serv,-) 0
   set astk::inv(serv,$astk::config(-1,nom)) -1
   set astk::inv(cmpl,$astk::config(-1,nom_complet),$astk::config(-1,login)) -1
   for { set is 0 } { $is < $astk::config(nb_serv) } { incr is } {
      set astk::inv(serv,$astk::config($is,nom)) $is
      for {set k 0} {$k < $is} {incr k} {
         if { $astk::config($k,nom_complet) == $astk::config($is,nom_complet)
           && $astk::config($k,login) == $astk::config($is,login)
           && $astk::config($k,etat) != "off"
           && $astk::config($is,etat) != "off" } {
            set astk::config($is,etat) "off"
            set msg [ashare::mess erreur 48 $astk::config($k,nom) $astk::config($is,nom)]
            if { $ashare::show_dialog == 1 } {
               tk_messageBox -title [ashare::mess ihm 138] -message $msg -type ok -icon error -parent .
            }
            break
         }
      }
      if { $astk::config($is,etat) != "off" } {
         set astk::inv(cmpl,$astk::config($is,nom_complet),$astk::config($is,login)) $is
         for { set in 0 } { $in < $astk::config($is,nb_noeud) } { incr in } {
            set deja 0
            for {set k 0} {$k < $i} {incr k} {
               if { $astk::ihm(lnoeud,$k) == $astk::config($is,noeud,$in) } {
                  set deja 1
                  break
               }
            }
            if { $deja } {
               ashare::mess info 28 $astk::config($is,noeud,$in) $astk::config($is,nom)
            } else {
               set astk::ihm(lnoeud,$i) $astk::config($is,noeud,$in)
               if { $astk::profil(noeud) == $astk::ihm(lnoeud,$i) } {
                  set pastrouve 0
               }
               incr i
            }
         }
      }
   }
   set astk::ihm(nb_noeud) $i
# il faut réinitialiser serveur/noeud/version
   if { $pastrouve && $i > 0 } {
      set astk::profil(noeud) $astk::ihm(lnoeud,0)
   }
# debug
   if { $ashare::dbg >= 5 } {
      for { set is 0 } { $is < $astk::config(nb_serv) } { incr is } {
         ashare::log "<DEBUG> (cree_liste_machines) astk::inv(serv,$astk::config($is,nom)) = $astk::inv(serv,$astk::config($is,nom))"
         catch {
            ashare::log "                              astk::inv(cmpl,$astk::config($is,nom_complet),$astk::config($is,login)) = $astk::inv(cmpl,$astk::config($is,nom_complet),$astk::config($is,login))"
         }
      }
   }
}

# retourne le serveur connecté à un noeud particulier
#################################################################
proc quel_serveur { noeud } {
   set i 0
   for { set is 0 } { $is < $astk::config(nb_serv) } { incr is } {
      set serv $astk::config($is,nom)
      for { set in 0 } { $in < $astk::config($is,nb_noeud) } { incr in } {
         if { $astk::config($is,noeud,$in) == $noeud } {
            if { $ashare::dbg >= 4 } {
               ashare::log "<DEBUG> (quel_serveur) $noeud est connecté à $serv" }
            return $is
         }
      }
   }
   # si on ne l'a pas trouvé
   if { $ashare::dbg >= 3 } {
      ashare::log "<DEBUG> (quel_serveur) $noeud non trouvé" }
   return "-"
}

# vérifie qu'un serveur existe, retourne :
#  -999 si le serveur n'est pas dans la liste,
#  -888 si le server est dans la liste mais dans l'état "off",
#  indice dans astk::config si le serveur est dans la liste et "on".
# champ vaut nom ou nom_complet selon le test voulu
#################################################################
proc valid_serveur { serv user champ} {
   set iret -999
   if { $serv == $astk::local_server && $champ == "nom" } {
      set iret -1
   } else {
      for { set is 0 } { $is < $astk::config(nb_serv) } { incr is } {
         if {  ($champ == "nom" && $serv == $astk::config($is,$champ))
            || ($champ == "nom_complet"
                 && [ashare::meme_machine $serv $astk::config($is,$champ)]
                 && ($user == "" || $user == $astk::config($is,login))) } {
            if { $astk::config($is,etat) == "on" } {
               if { $astk::config($is,islocal) == "oui" } {
                  set iret -1
               } else {
                  set iret $is
               }
            } else {
               set iret -888
            }
            break
         }
      }
   }
   # si on ne l'a pas trouvé
   if { $ashare::dbg >= 4 } {
      if { $iret == -999 } {
         ashare::log "<DEBUG> (valid_serveur) $serv (user=$user) n'existe plus"
      } elseif { $iret == -888 }  {
         ashare::log "<DEBUG> (valid_serveur) $serv (user=$user) est inaccessible (etat=off)"
      }
   }
   return $iret
}

# vérifie les serveurs des profils rémanents
#################################################################
proc cohe_prof { } {
   set nb 0
   for {set i 0} {$i < $astk::ihm(prof,nb)} {incr i} {
      if { [valid_serveur $astk::ihm(prof,serv,$i) "" nom] != -999 } {
         set astk::ihm(prof,$nb) $astk::ihm(prof,$i)
         set astk::ihm(prof,serv,$nb) $astk::ihm(prof,serv,$i)
         incr nb
      }
   }
   set astk::ihm(prof,nb) $nb
}

# vérifie que :
#   - les serveurs des fichiers d'un profil sont tjs dans la config
#   - le type des fichiers existe toujours
#################################################################
proc cohe_fich { } {
   set err 0
   foreach var { etude tests sources surcharge } {
      for {set i 0} {$i < $astk::profil($var,nbfic)} {incr i} {
         if { [valid_serveur $astk::profil($var,fich,$i,serv) "" nom] == -999 } {
            ashare::mess info 18 $astk::profil($var,fich,$i,serv) $astk::local_server
            set astk::profil($var,fich,$i,serv) $astk::local_server
            incr err
         }
      }
      if { $astk::profil(serv_$var) > [expr $astk::config(nb_serv) - 1] } {
         set astk::profil(serv_$var) -1
      }
   }
   if { $err > 0 } {
      return 2
   }
   return 0
}