This file is indexed.

/usr/share/astk/remote_tools.tcl is in code-aster-gui 1.8.4-5.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
#########################################################################
# 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: remote_tools.tcl 3579 2008-10-24 13:33:54Z courtois $

# ajout des arguments globaux : remote_copy_protocol, remote_shell_protocol, rcdir
#################################################################
proc ashare::get_glob_args { } {
   set lcmd ""
   append lcmd " --remote_shell_protocol=$astk::config(-1,remote_shell_protocol)"
   append lcmd " --remote_copy_protocol=$astk::config(-1,remote_copy_protocol)"
   if { $astk::rcdir_mod } {
      append lcmd " --rcdir=$astk::rcdir"
   }
   return $lcmd
}

# enrobage pour l'appel au browser multi-machines
# numéro du serveur, le chemin+nom, le type (F ou R)
# retourne 0 si ok, 1 sinon
#################################################################
proc ashare::selecteur {srv_OUT dir_OUT typ_OUT srv_IN dir_IN typ_IN {args_sup ""}} {
   upvar $srv_OUT srv
   upvar $dir_OUT dir
   upvar $typ_OUT typ
# voir les serveurs que l'on garde
   set isrv_IN ""
   set k -1
   for { set j -1 } { $j < $astk::config(nb_serv) } { incr j } {
      if { $astk::config($j,etat) == "on" } {
         set cfg($k,num)         $j
         set cfg($k,nom)         $astk::config($j,nom)
         set cfg($k,nom_complet) $astk::config($j,nom_complet)
         set cfg($k,login)       $astk::config($j,login)
         set cfg($k,home)        $astk::config($j,home)
         set cfg($k,xterm)       $astk::config($j,xterm)
         if { $srv_IN == $j } {
            set isrv_IN $k
         }
         if { $ashare::dbg >= 4 } {
            ashare::log "<DEBUG> (selecteur) machine $k : $cfg($k,nom_complet)"
         }
         incr k
      }
   }
   set cfg(nb_serv) $k
   set cfg(-1,remote_shell_protocol) $astk::config(-1,remote_shell_protocol)
   set cfg(-1,remote_copy_protocol)  $astk::config(-1,remote_copy_protocol)
# prépare les arguments
   set args ""
   if { $isrv_IN != "" } {
      append args " -initialsrv $isrv_IN"
   }
   if { $dir_IN != "" } {
      append args " -initialdir $dir_IN"
   }
   if { $typ_IN == "" } {
      append args " -typeOut \"FR\""
   } elseif { $typ_IN == "F" } {
      append args " -typeOut \"F\""
   } elseif { $typ_IN == "R" } {
      append args " -typeOut \"R\""
   }
   if { $ashare::dbg >= 4 } {
      append args " -debug"
      ashare::log "<DEBUG> (selecteur) cfg  : [array get cfg]"
      ashare::log "<DEBUG> (selecteur) args : $args"
   }
   append args " $args_sup"
   set lstemp [eval tkgetdir::tk_getDirectory cfg -font {$astk::ihm(font,brwlst)} $args]
   set iret 1
   set srv ""
   set dir ""
   set typ ""
   if { [string length [lindex $lstemp 1]] > 0 } {
      set srv $cfg([lindex $lstemp 0],num)
      set dir [lindex $lstemp 1]
      set typ [lindex $lstemp 2]
      set iret 0
      if { $ashare::dbg >= 4 } {
         ashare::log "<DEBUG> (selecteur) iret=$iret ; srv # dir # typ : $srv # $dir # $typ"
      }
   }
   return $iret
}

# substitue des variables avant l'appel à une commande
#   @D = $DISPLAY
#   @F = nom du fichier sélectionné (avec le répertoire)
#   @f = nom du fichier sans le répertoire
#   @R = répertoire contenant le fichier sélectionné
#################################################################
proc ashare::subst_var { cmd } {
   regsub -all "@D" $cmd $ashare::DISPLAY cmd
   set name $astk::sel(filename)
#   if { $name != "" } {
   set dir  [file dirname $name]
   set base [file tail $name]
   # on ne remplace qui si suivi d'un espace ou fin de ligne
   regsub -all "@F " $cmd "$name " cmd
   regsub -all "@f " $cmd "$base " cmd
   regsub -all "@R " $cmd "$dir " cmd
   regsub -all "@F\$" $cmd "$name " cmd
   regsub -all "@f\$" $cmd "$base " cmd
   regsub -all "@R\$" $cmd "$dir " cmd
#   }
   return $cmd
}

# exécute une commande sur un serveur
# substitue les valeurs des variables utilisateur éventuelles
# -1 représente la machine interface
# le tableau de config contient :
# cfg(n°serv,nom_complet) et cfg(n°serv,login)
# c'est à l'appelant d'émettre ou non un message en fonction du code retour
#################################################################
proc ashare::rexec_cmd { serv cfg prog args bg output {parent ""}} {
   upvar $output msg
   upvar $cfg config
   # on récupère stdout et stderr dans un fichier unique
   set num [clock clicks -milliseconds]
   set fout [file join $astk::tmpdir .file_rexec_out]
   append fout "_$num"
   set ferr [file join $astk::tmpdir .file_rexec_err]
   append ferr "_$num"
   # vérifier qu'il n'y a pas de redirection dans la commande
   # numero du process : process

# attente
   ashare::pointeur off
# local ?
   if { $astk::config($serv,islocal) == "oui" ||
        ([ashare::meme_machine $config($serv,nom_complet) $config(-1,nom_complet)]
         && $config($serv,login) == $config(-1,login)) } {
      set serv -1
   }
# substitution des variables et arguments
   append prog " $args"
   set cmd [ ashare::subst_var $prog ]
#
   ashare::mess info 44 $config($serv,nom_complet) $cmd $serv
   if { $serv >= 0 } {
      if { $config(-1,remote_shell_protocol) == "" || $config(-1,remote_shell_protocol) == "RSH" } {
         if { $config($serv,login) != "" } {
            catch { exec rsh -n -l $config($serv,login) $config($serv,nom_complet) $cmd > $fout 2> $ferr & } process
         } else {
            catch { exec rsh -n $config($serv,nom_complet) $cmd > $fout 2> $ferr & } process
         }
      } elseif { $config(-1,remote_shell_protocol) == "SSH" } {
         if { $config($serv,login) != "" } {
            catch { exec ssh -n -l $config($serv,login) $config($serv,nom_complet) $cmd > $fout 2> $ferr & } process
         } else {
            catch { exec ssh -n $config($serv,nom_complet) $cmd > $fout 2> $ferr & } process
         }
      } else {
         set iret 127
         ashare::mess erreur 49 $config(-1,remote_shell_protocol)
         return $iret
      }
   } else {
      set cmd "exec $cmd > $fout 2> $ferr &"
      catch { eval $cmd } process
   }
# attendre la fin si background non demandé
   if { $bg == 0 } {
      ashare::mess info 45 $process

      if { [regexp {^[ ]*([0-9]+)[ ]*} $process] == 0 } {
         set msg $process
         return -999
      }
         set ashare::fini($process) 0
         set ashare::cycle($process) 0
         ashare::attend $process $fout $parent
         tkwait variable ashare::fini($process)
   }
# mettre l'output dans msg
   set idf [open $ferr r]
   set msgerr [read -nonewline $idf]
   close $idf
   set idf [open $fout r]
   set msg [read -nonewline $idf]
   close $idf
   if { $ashare::dbg < 5 } {
      file delete -force $fout
   }

# code retour renvoyé par as_run dans l'output (car rsh renvoie 0)
   set iret_gene 0
   set iret [list]
   set next $msg
   while { [regexp {EXIT_CODE=([-0-9]+)(.*)} $next mat1 iv next] } {
      lappend iret $iv
      if { $iv != 0 } {
         set iret_gene 1
      }
   }
# pb de quota ?
   if { [regexp -nocase {quota.*exceed} $msg] } {
      ashare::mess info 46 $msg
      ashare::mess info 49 $msgerr
      tk_messageBox -title "$ashare::msg($ashare::lang,erreur,txt)" -message [ashare::mess erreur 32 $config($serv,nom_complet)] -type ok
   }
   ashare::pointeur on
   if { [lsearch $iret -999] > -1 } {
      set ich [tk_messageBox -title [ashare::mess ihm 138] -message [ashare::mess erreur 24] -type ok]
   }
# tcl 8.4 : [lsearch -not $iret 0]
   if { [lsearch -regexp $iret {[^0]}] > -1 || $ashare::dbg >= 1 } {
      ashare::mess info 46 $msg
   }
   if { [lsearch -regexp $iret {[^0]}] > -1 || $ashare::dbg >= 3 } {
      ashare::mess info 49 $msgerr
   }
# traitement du code retour (on retourne la valeur s'il n'y en a qu'une, 0 si on n'a rien d'autre !)
   if { [llength $iret] == 0 } {
      set iret 0
   } elseif { [llength $iret] == 1 } {
      set iret [lindex $iret 0]
   }
   if { $ashare::dbg >= 2 && $iret_gene != 0 } {
      ashare::mess info 47 $iret
   }
   return $iret
}

# copie de fichiers ou répertoires direct ou par rcp
# si option=commande, on renvoie la ligne de commande pour faire la copie
#################################################################
proc ashare::rcp_cmd { cfg serv1 fich1 serv2 fich2 option {parent ""}} {
   upvar $cfg config
# attente
   ashare::pointeur off
# local ?
   set serv -1
   set remote 0
   set src  $fich1
   set dest $fich2
   if { $astk::config($serv1,islocal) != "oui"
     || [ashare::meme_machine $config($serv1,nom_complet) $config(-1,nom_complet)] != 1
     || $config($serv1,login) != $config(-1,login) } {
      set src $config($serv1,login)@$config($serv1,nom_complet):$fich1
      incr remote
   }
   if { $astk::config($serv2,islocal) != "oui"
     || [ashare::meme_machine $config($serv2,nom_complet) $config(-1,nom_complet)] != 1
     || $config($serv2,login) != $config(-1,login) } {
      set dest $config($serv2,login)@$config($serv2,nom_complet):$fich2
      incr remote
   }
#
   if { $remote == 0 } {
      set cmd "cp -r $fich1 $fich2"
   } else {
      set proto $config(-1,remote_copy_protocol)
      if { $remote == 2 } {
         set serv $serv1
         # pas possible en rsync
         if { $proto == "RSYNC" } {
            set proto RCP
         }
      }
      if { $proto == "" || $proto == "RCP" } {
         set cmd "rcp -r $src $dest"
      } elseif { $proto == "RSYNC" } {
         set cmd "rsync -rz $src $dest"
      } elseif { $proto == "SCP" } {
         set cmd "scp -rBCq $src $dest"
      } else {
         set iret 127
         ashare::mess erreur 49 $proto
         return $iret
      }
   }

   if { $ashare::dbg >= 4 } {
      ashare::log "<DEBUG> (rcp_cmd) commande : $cmd"
   }
   if { $option == "commande" } {
      return $cmd
   } else {
      set cmd "$astk::cmd(shell_cmd) \"$cmd; echo EXIT_CODE=\$?\""
   }

   set iret [ashare::rexec_cmd $serv config $cmd "" 0 out $parent]
   if { $iret != 0 } {
      ashare::mess "erreur" 3 "rcp_cmd de $config($serv1,nom_complet):$fich1 vers $config($serv2,nom_complet):$fich2" $iret $out
   }
   ashare::pointeur on
   return $iret
}

# interrompt le process
#################################################################
proc ashare::kill { process fout } {
   set cmd "exec kill -9 $process"
   catch { eval $cmd } out
   # ajoute un exit code dans le fichier output de la commande
   set cmd "exec \\echo EXIT_CODE=-999 >> $fout"
   catch { eval $cmd } out
}

# vérifie que le process tourne encore, sinon ferme la fenetre interrompre
# on cartonne errorCode quand le process est fini (grep)
#################################################################
proc ashare::attend { process fout {parent ""}} {
   incr ashare::cycle($process)
   #ashare::log "<DEBUG> (attend) Process $process, cycle numéro : $ashare::cycle($process)"
   # on attend le 2ème passage avant de faire quoique ce soit
   # sinon on risque de fixer fini=1 avant d'arriver au tkwait
   if { $ashare::cycle($process) > 1 } {
      set cmd "exec $astk::cmd(shell_cmd) \"$astk::cmd(ps) -p $process | grep $process | grep -vc grep\""
      catch { eval $cmd } out
      # au cas où le regexp ne trouve rien, on considère que c'est fini
      set nocc 0
      regexp {([0-9]+)} $out mat1 nocc
      if { $nocc != 0 } {
         # on n'affiche la fenêtre qu'à partir du passage N
         if { [winfo exists $astk::ihm(interrompre)] == 0
           && $ashare::cycle($process) > 2
           && $parent != "" } {
            display_cancel_button $process $fout $parent
         }
      # scrute le process toutes les 100 millisecondes
         after 100 "ashare::attend $process $fout $parent"
      } else {
         set ashare::fini($process) 1
         catch {destroy $astk::ihm(interrompre)}
      }
   } else {
      after 50 "ashare::attend $process $fout $parent"
   }
}

# affiche le bouton interrompre
# intégré ou non à la fenêtre principale
#################################################################
proc display_cancel_button { process fout {parent ""}} {
    set fen $astk::ihm(status).st.cancel
    if { (! [winfo exists $fen]) || [string first ".dirsel_" $parent] == 0 } {
        display_cancel_button_externe $process $fout $parent
    } else {
        set astk::ihm(interrompre) $fen.int
        set fen $astk::ihm(interrompre)
        catch {destroy $fen}
        button $fen -text [ashare::mess ihm 230] \
           -font $astk::ihm(font,labbout) -background $astk::ihm(couleur,suppr) \
           -command "ashare::kill $process $fout ; destroy $fen"
        pack $fen
        catch {grab set $fen}
    }
}

# affiche le bouton interrompre externe
#################################################################
proc display_cancel_button_externe { process fout {parent ""}} {
    set fen $astk::ihm(interrompre)
    toplevel $fen
    wm transient $fen $parent
    wm withdraw $fen
    catch {grab set $fen}
    $fen configure -cursor pirate
    button $fen.int -text [ashare::mess ihm 230] \
       -font $astk::ihm(font,labbout) -background $astk::ihm(couleur,suppr) \
       -command "ashare::kill $process $fout ; destroy $fen"
    pack $fen.int
    wm protocol $fen WM_DELETE_WINDOW "$fen.int invoke"
    ashare::centre_fen $fen $parent
    wm deiconify $fen
}


# machines identiques ?
# sans le nom de domaine
#################################################################
proc ashare::meme_machine { nom1 nom2 } {
   set iret 0
   # ne rien faire si adresse IP
   if { [regexp {[a-zA-Z]+} $nom1] } {
      regsub -all {\..*$} $nom1 "" nom1
   }
   if { [regexp {[a-zA-Z]+} $nom2] } {
      regsub -all {\..*$} $nom2 "" nom2
   }
   if { $nom1 == $nom2 } {
      set iret 1
   }
   return $iret
}