improved UI to attach (no longer takes in a directory; option on
[dyninst.git] / paradyn / tcl / applic.tcl
1 #applic.tcl
2 # window to get application choices from user
3
4 #
5 #  Process definitions depend on several global variables.
6 #
7 #  applicDaemon  -- name of the paradyn daemon
8 #  applicUser    -- user name
9 #  applicMachine -- machine to use
10 #  applicCmd     -- command to run (including arguments)
11 #  applicDir     -- directory to chdir
12 #
13 #  It would be nice if there were a better way to specify defaults
14 #  such as these.
15 #
16
17 #
18 # this is a strange way to say "if default daemon name
19 # is not set then set it to defd"
20 #
21 if {[catch {set applicDaemon}]} {
22   set applicDaemon defd
23 }
24
25 #
26 #  display a dialog box that prompts for daemon, 
27 #  user name, machine name, command and arguments
28 #
29 #  the user finishes selection, the dialog disappears, and 
30 #  the new process is started
31 #
32 #  TODO -- use the dialog creation routine in uimpd file
33 #
34 proc AttachProcess {} {
35   global env applicDaemon applicUser applicMachine applicCmd applicDir 
36
37   set W .attachDefn
38
39   # If the window already exists, the following line brings it to the fore.  In other
40   # words, if "Attach" is chosen twice from the menu, only one window appears.
41   if {[winfo exists $W]} {
42      puts stderr "attach: the window already exists...bringing it to fore"
43
44      wm deiconify $W
45      raise $W
46      return
47   }
48
49   if {[winfo exists .pDefn]} {
50      puts stderr "attach: the process definition window is already up...killing it"
51      destroy .pDefn
52   }
53
54   toplevel $W
55   wm title $W "Attach"
56   wm iconname $W "Attach"
57
58 # force the window to a happy location
59   set baseGeom [wm geometry .]
60   set Xbase 0
61   set Ybase 0
62   set Xoffset 30
63   set Yoffset 30
64   scan $baseGeom "%*dx%*d+%d+%d" Xbase Ybase
65   wm geometry $W [format "+%d+%d" [expr $Xbase + $Xoffset] \
66                                       [expr $Ybase + $Yoffset]]
67  
68 # define all of the main frames
69   set T $W.title
70   label $T -text "Attach to a Process" \
71             -anchor center -relief raised \
72             -font "-Adobe-times-bold-r-normal--*-120*" 
73   set D $W.data
74   frame $D
75   set B $W.buttons
76   frame $B
77   pack $T $D $B -side top -expand yes -fill both
78
79 #
80 #  In the data area, each line contains a label and an entry
81 #  
82   frame $D.user -border 2
83   pack $D.user -side top -expand yes -fill x
84   label $D.user.lbl -text "User: " -anchor e -width 14
85   pack $D.user.lbl -side left -expand false
86   entry $D.user.ent -width 50 -textvariable applicUser -relief sunken
87   pack  $D.user.ent -side right -fill x -expand true
88   bind $D.user.ent <Return> "$B.1 invoke"
89
90   frame $D.machine -border 2
91   pack $D.machine -side top -expand yes -fill x
92   label $D.machine.lbl -text "Host: " -anchor e -width 14
93   pack $D.machine.lbl -side left -expand false
94   entry $D.machine.ent -width 50 -textvariable applicMachine -relief sunken
95   pack $D.machine.ent -side right -fill x -expand true
96   bind $D.machine.ent <Return> "$B.1 invoke"
97
98   # Does a directory entry make any sense for attach???  Probably not...it's only
99   # useful in the non-attach case to remove the need to use full-path-names for
100   # arguments, input files, etc.  Here, we don't use that.
101
102 #  frame $D.directory -border 2
103 #  pack  $D.directory -side top -expand yes -fill x
104 #  label $D.directory.lbl -text "Directory: " -anchor e -width 14
105 #  pack  $D.directory.lbl -side left -expand false
106 #  entry $D.directory.ent -width 50 -textvariable applicDir -relief sunken
107 #  pack  $D.directory.ent -side right -fill x -expand true
108 #  bind  $D.directory.ent <Return> "$B.1 invoke"
109
110   frame $D.command -border 2
111   pack  $D.command -side top -fill x -expand false
112   entry $D.command.entry -textvariable applicCommand -relief sunken
113   pack  $D.command.entry -side right -fill x -expand true
114   bind  $D.command.entry <Return> "$B.1 invoke"
115
116   label $D.command.label -text "Executable file: " -anchor e -width 14
117   pack  $D.command.label -side left -expand false
118   
119
120   frame $D.pid -border 2
121   pack  $D.pid -side top -fill x -expand false
122   entry $D.pid.entry -textvariable applicPid -relief sunken
123   pack  $D.pid.entry -side right -fill x -expand true
124   bind  $D.pid.entry <Return> "$B.1 invoke"
125
126   label $D.pid.label -text "Pid: " -anchor e -width 14
127   pack  $D.pid.label -side left -expand false
128
129
130   set daemons [paradyn daemons]
131   frame $D.daemon -border 2
132   label $D.daemon.lbl -text "Daemon: " -anchor e -width 14
133   pack $D.daemon -side top -expand yes -fill x
134   pack $D.daemon.lbl -side left -expand no -fill x
135   foreach d $daemons {
136     radiobutton $D.daemon.$d -text $d -variable applicDaemon -value $d \
137         -relief flat
138     pack $D.daemon.$d -side left -expand yes -fill x
139   }
140   $D.daemon.$applicDaemon invoke
141
142
143   # user interface tips:
144   frame $D.tips
145   pack  $D.tips -side top -fill x
146
147   frame $D.tips.1
148   pack  $D.tips.1 -side top -fill x
149
150   label $D.tips.1.label -text "Entering a pid is mandatory." \
151           -font "*-Helvetica-*-r-*-12-*" -justify left
152   pack  $D.tips.1.label -side left
153
154   frame $D.tips.2
155   pack  $D.tips.2 -side top -fill x
156   
157   label $D.tips.2.label \
158           -text "Enter the full path to the executable in 'Executable file'. It will be used just to parse the symbol table.\nParadyn tries to determine this information automatically, so you can usually leave 'Executable file' blank." \
159           -font "*-Helvetica-*-r-*-12-*" -justify left
160   pack  $D.tips.2.label -side left -fill x
161
162
163
164   frame $D.run -border 2
165   pack  $D.run -side top -fill x
166
167   label $D.run.label -text "After attaching: " -justify left \
168           -font "*-Helvetica-*-r-*-12-*"
169   pack  $D.run.label -side left
170
171   global afterAttaching
172   set afterAttaching 0
173
174   frame $D.run.fr
175   pack  $D.run.fr -ipady 2 -pady 4 -side left -fill x -expand true
176
177   radiobutton $D.run.fr.1 -text "Pause application" -variable afterAttaching -value 1 \
178           -justify left -relief groove -highlightthickness 0 \
179           -font "*-Helvetica-*-r-*-12-*"
180   pack $D.run.fr.1 -side left -fill x -expand true
181
182   radiobutton $D.run.fr.2 -text "Run application" -variable afterAttaching -value 2 \
183           -justify left -relief groove -highlightthickness 0 \
184           -font "*-Helvetica-*-r-*-12-*"
185   pack $D.run.fr.2 -side left -fill x -expand true
186
187   radiobutton $D.run.fr.3 -text "Leave as is" -variable afterAttaching -value 0 \
188           -justify left -relief groove -highlightthickness 0 \
189           -font "*-Helvetica-*-r-*-12-*"
190   pack $D.run.fr.3 -side left -fill x -expand true
191
192
193
194   mkButtonBar $B {} retVal \
195   {{"ATTACH" {AcceptAttachDefn $applicUser $applicMachine \
196           $applicCommand $applicPid $applicDaemon $afterAttaching}} \
197   {"CANCEL" {destroy .attachDefn}}}
198
199   focus $D.machine.ent
200 }
201
202 proc DefineProcess {} {
203   global env applicDaemon applicUser applicMachine applicCmd applicDir 
204
205   set W .pDefn
206
207   # If the window already exists, the following line brings it to the fore.  In other
208   # words, if "Attach" is chosen twice from the menu, only one window appears.
209   if {[winfo exists $W]} {
210      puts stderr "DefineProcess: the window already exists...bringing it to fore"
211
212      wm deiconify $W
213      raise $W
214      return
215   }
216
217   if {[winfo exists .attachDefn]} {
218      puts stderr "DefineProcess: the attach definition window is already up...killing it"
219      destroy .attachDefn
220   }
221
222   toplevel $W
223   wm title $W "Process Defn"
224   wm iconname $W "Process Defn"
225
226 # force the window to a happy location
227   set baseGeom [wm geometry .]
228   set Xbase 0
229   set Ybase 0
230   set Xoffset 30
231   set Yoffset 30
232   scan $baseGeom "%*dx%*d+%d+%d" Xbase Ybase
233   wm geometry .pDefn [format "+%d+%d" [expr $Xbase + $Xoffset] \
234                                       [expr $Ybase + $Yoffset]]
235  
236 # define all of the main frames
237   set T $W.title
238   label $T -text "Define A Process" \
239             -anchor center -relief raised \
240             -font "-Adobe-times-bold-r-normal--*-120*" 
241   set D $W.data
242   frame $D
243   set B $W.buttons
244   frame $B
245   pack $T $D $B -side top -expand yes -fill both
246
247 #
248 #  In the data area, each line contains a label and an entry
249 #  
250   frame $D.user -border 2
251   label $D.user.lbl -text "User: " -anchor e -width 12
252   entry $D.user.ent -width 50 -textvariable applicUser -relief sunken
253   bind $D.user.ent <Return> "$B.1 invoke"
254   pack $D.user -side top -expand yes -fill x
255   pack $D.user.lbl $D.user.ent -side left -expand yes -fill x
256
257   frame $D.machine -border 2
258   label $D.machine.lbl -text "Host: " -anchor e -width 12
259   entry $D.machine.ent -width 50 -textvariable applicMachine -relief sunken
260   bind $D.machine.ent <Return> "$B.1 invoke"
261   pack $D.machine -side top -expand yes -fill x
262   pack $D.machine.lbl $D.machine.ent -side left -expand yes -fill x
263
264   frame $D.directory -border 2
265   label $D.directory.lbl -text "Directory: " -anchor e -width 12
266   entry $D.directory.ent -width 50 -textvariable applicDir -relief sunken
267  bind $D.directory.ent <Return> "$B.1 invoke"
268   pack $D.directory -side top -expand yes -fill x
269   pack $D.directory.lbl $D.directory.ent -side left -expand yes -fill x
270   
271   set daemons [paradyn daemons]
272   frame $D.daemon -border 2
273   label $D.daemon.lbl -text "Daemon: " -anchor e -width 12
274   pack $D.daemon -side top -expand yes -fill x
275   pack $D.daemon.lbl -side left -expand no -fill x
276   foreach d $daemons {
277     radiobutton $D.daemon.$d -text $d -variable applicDaemon -value $d \
278         -relief flat
279     pack $D.daemon.$d -side left -expand yes -fill x
280   }
281   $D.daemon.$applicDaemon invoke
282
283   frame $D.cmd -border 2
284   label $D.cmd.lbl -text "Command: " -anchor e -width 12
285   entry $D.cmd.ent -width 50 -textvariable applicCmd -relief sunken
286   bind $D.cmd.ent <Return> "$B.1 invoke"
287   pack $D.cmd -side top -expand yes -fill x
288   pack $D.cmd.lbl $D.cmd.ent -side left -expand yes -fill x
289
290   mkButtonBar $B {} retVal \
291   {{"ACCEPT" {AcceptNewApplicDefn $applicUser $applicMachine \
292           $applicDaemon $applicDir $applicCmd}} \
293   {"CANCEL" {destroy .pDefn}}}
294
295   focus $D.machine.ent
296 }
297
298 #
299 #  when the user has accepted a new application definition, 
300 #  we invoke this command to start the process.
301 #
302 #  <cmd> is passed directly to execv() with no
303 #  further parsing or substition
304 #
305 #  any errors in process startup are reported through error dialogs
306 #  (i.e. there is no useful return value from this proc)
307 #
308 #  TODO: we must have very specific reporting of process startup
309 #        failures.  the current error message is useless.
310 #
311 proc AcceptNewApplicDefn {user machine daemon directory cmd} {
312   set W .pDefn
313   set D $W.data
314
315   if {[string length $cmd] == 0} {
316       # user forgot to enter a command (program name + args); ring bell
317       puts "\a"
318       return
319   }
320   set pcmd [list paradyn process]
321
322   if {[string length $user] > 0} {
323     lappend pcmd "-user" $user
324   }
325
326   if {[string length $machine] > 0} {
327     lappend pcmd "-machine" $machine
328   }
329
330   if {[string length $directory] > 0} {
331     lappend pcmd "-dir" $directory
332   }
333
334   if {[string length $daemon] > 0} {
335     lappend pcmd "-daemon" $daemon
336   }
337
338   set pcmd [concat $pcmd $cmd]
339  
340   destroy $W
341
342   # Now execute it!
343   set retval [catch $pcmd result]
344
345   if {$retval == 1} {
346 #    set result "Illegal Process Definition"
347     eval [list uimpd showError 25 $result]
348   }
349 }
350
351 proc AcceptAttachDefn {user machine cmd pid daemon afterAttach} {
352   set W .attachDefn
353
354   if {[string length $cmd] == 0 && [string length $pid] == 0} {
355       # must enter at least one of (cmd, pid); ring bell
356       puts "\a"
357       return
358   }
359
360   set pcmd [list paradyn attach]
361
362   if {[string length $user] > 0} {
363     lappend pcmd "-user" $user
364   }
365
366   if {[string length $machine] > 0} {
367     lappend pcmd "-machine" $machine
368   }
369
370   if {[string length $cmd] > 0} {
371      lappend pcmd "-command" $cmd
372   }
373
374   if {[string length $pid] > 0} {
375      lappend pcmd "-pid" $pid
376   }
377
378   if {[string length $daemon] > 0} {
379     lappend pcmd "-daemon" $daemon
380   }
381
382   if {[string length $afterAttach]} {
383     lappend pcmd "-afterattach" $afterAttach
384     # 0 --> leave as is; 1 --> pause; 2 --> run
385   }
386
387   destroy $W
388
389 #puts stderr $pcmd
390
391   # Now execute it!
392   set retval [catch $pcmd result]
393
394   if {$retval == 1} {
395     eval [list uimpd showError 26 $result]
396   }
397 }