*** empty log message ***
[dyninst.git] / paradyn / tcl / applic.tcl
1 # $Id: applic.tcl,v 1.22 1998/03/03 23:09:44 wylie Exp $
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 { Times 12 bold }
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 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           -font { Helvetica 12 } -justify left \
159           -text "Enter the full path to the executable in 'Executable file'.\
160                 It will be used just to parse the symbol table.\n\
161                 Paradyn tries to determine this information automatically,\
162                 so you can usually leave 'Executable file' blank."
163   pack  $D.tips.2.label -side left -fill x
164
165
166
167   frame $D.run -border 2
168   pack  $D.run -side top -fill x
169
170   label $D.run.label -text "After attaching: " -justify left \
171           -font { Helvetica 12 }
172   pack  $D.run.label -side left
173
174   global afterAttaching
175   set afterAttaching 0
176
177   frame $D.run.fr
178   pack  $D.run.fr -ipady 2 -pady 4 -side left -fill x -expand true
179
180   radiobutton $D.run.fr.1 -text "Pause application" -variable afterAttaching \
181           -value 1 -justify left -relief groove -highlightthickness 0 \
182           -font { Helvetica 12 }
183   pack $D.run.fr.1 -side left -fill x -expand true
184
185   radiobutton $D.run.fr.2 -text "Run application" -variable afterAttaching \
186           -value 2 -justify left -relief groove -highlightthickness 0 \
187           -font { Helvetica 12 }
188   pack $D.run.fr.2 -side left -fill x -expand true
189
190   radiobutton $D.run.fr.3 -text "Leave as is" -variable afterAttaching \
191           -value 0 -justify left -relief groove -highlightthickness 0 \
192           -font { Helvetica 12 }
193   pack $D.run.fr.3 -side left -fill x -expand true
194
195
196
197   mkButtonBar $B {} retVal \
198   {{"ATTACH" {AcceptAttachDefn $applicUser $applicMachine \
199           $applicCommand $applicPid $applicDaemon $afterAttaching}} \
200   {"CANCEL" {destroy .attachDefn}}}
201
202   focus $D.machine.ent
203 }
204
205 proc DefineProcess {} {
206   global env applicDaemon applicUser applicMachine applicCmd applicDir 
207
208   set W .pDefn
209
210   # If the window already exists, the following line brings it to the fore.  In other
211   # words, if "Attach" is chosen twice from the menu, only one window appears.
212   if {[winfo exists $W]} {
213      puts stderr "DefineProcess: the window already exists...bringing it to fore"
214
215      wm deiconify $W
216      raise $W
217      return
218   }
219
220   if {[winfo exists .attachDefn]} {
221      puts stderr "DefineProcess: the attach definition window is already up...killing it"
222      destroy .attachDefn
223   }
224
225   toplevel $W
226   wm title $W "Process Defn"
227   wm iconname $W "Process Defn"
228
229 # force the window to a happy location
230   set baseGeom [wm geometry .]
231   set Xbase 0
232   set Ybase 0
233   set Xoffset 30
234   set Yoffset 30
235   scan $baseGeom "%*dx%*d+%d+%d" Xbase Ybase
236   wm geometry .pDefn [format "+%d+%d" [expr $Xbase + $Xoffset] \
237                                       [expr $Ybase + $Yoffset]]
238  
239 # define all of the main frames
240   set T $W.title
241   label $T -text "Define A Process" \
242             -anchor center -relief raised \
243             -font { Times 12 bold }
244   set D $W.data
245   frame $D
246   set B $W.buttons
247   frame $B
248   pack $T $D $B -side top -expand yes -fill both
249
250 #
251 #  In the data area, each line contains a label and an entry
252 #  
253   frame $D.user -border 2
254   label $D.user.lbl -text "User: " -anchor e -width 12
255   entry $D.user.ent -width 50 -textvariable applicUser -relief sunken
256   bind $D.user.ent <Return> "$B.1 invoke"
257   pack $D.user -side top -expand yes -fill x
258   pack $D.user.lbl $D.user.ent -side left -expand yes -fill x
259
260   frame $D.machine -border 2
261   label $D.machine.lbl -text "Host: " -anchor e -width 12
262   entry $D.machine.ent -width 50 -textvariable applicMachine -relief sunken
263   bind $D.machine.ent <Return> "$B.1 invoke"
264   pack $D.machine -side top -expand yes -fill x
265   pack $D.machine.lbl $D.machine.ent -side left -expand yes -fill x
266
267   frame $D.directory -border 2
268   label $D.directory.lbl -text "Directory: " -anchor e -width 12
269   entry $D.directory.ent -width 50 -textvariable applicDir -relief sunken
270  bind $D.directory.ent <Return> "$B.1 invoke"
271   pack $D.directory -side top -expand yes -fill x
272   pack $D.directory.lbl $D.directory.ent -side left -expand yes -fill x
273   
274   set daemons [paradyn daemons]
275   frame $D.daemon -border 2
276   label $D.daemon.lbl -text "Daemon: " -anchor e -width 12
277   pack $D.daemon -side top -expand yes -fill x
278   pack $D.daemon.lbl -side left -expand no -fill x
279   foreach d $daemons {
280     radiobutton $D.daemon.$d -text $d -variable applicDaemon -value $d \
281         -relief flat
282     pack $D.daemon.$d -side left -expand yes -fill x
283   }
284   $D.daemon.$applicDaemon invoke
285
286   frame $D.cmd -border 2
287   label $D.cmd.lbl -text "Command: " -anchor e -width 12
288   entry $D.cmd.ent -width 50 -textvariable applicCmd -relief sunken
289   bind $D.cmd.ent <Return> "$B.1 invoke"
290   pack $D.cmd -side top -expand yes -fill x
291   pack $D.cmd.lbl $D.cmd.ent -side left -expand yes -fill x
292
293   mkButtonBar $B {} retVal \
294   {{"ACCEPT" {AcceptNewApplicDefn $applicUser $applicMachine \
295           $applicDaemon $applicDir $applicCmd}} \
296   {"CANCEL" {destroy .pDefn}}}
297
298   focus $D.machine.ent
299 }
300
301 #
302 #  when the user has accepted a new application definition, 
303 #  we invoke this command to start the process.
304 #
305 #  <cmd> is passed directly to execv() with no
306 #  further parsing or substition
307 #
308 #  any errors in process startup are reported through error dialogs
309 #  (i.e. there is no useful return value from this proc)
310 #
311 #  TODO: we must have very specific reporting of process startup
312 #        failures.  the current error message is useless.
313 #
314 proc AcceptNewApplicDefn {user machine daemon directory cmd} {
315   set W .pDefn
316   set D $W.data
317
318   if {[string length $cmd] == 0} {
319       # user forgot to enter a command (program name + args); ring bell
320       puts "\a"
321       return
322   }
323   set pcmd [list paradyn process]
324
325   if {[string length $user] > 0} {
326     lappend pcmd "-user" $user
327   }
328
329   if {[string length $machine] > 0} {
330     lappend pcmd "-machine" $machine
331   }
332
333   if {[string length $directory] > 0} {
334     lappend pcmd "-dir" $directory
335   }
336
337   if {[string length $daemon] > 0} {
338     lappend pcmd "-daemon" $daemon
339   }
340
341   set pcmd [concat $pcmd $cmd]
342  
343   destroy $W
344
345   # Now execute it!
346   set retval [catch $pcmd result]
347
348   if {$retval == 1} {
349 #    set result "Illegal Process Definition"
350     eval [list uimpd showError 25 $result]
351   }
352 }
353
354 proc AcceptAttachDefn {user machine cmd pid daemon afterAttach} {
355   set W .attachDefn
356
357   if {[string length $cmd] == 0 && [string length $pid] == 0} {
358       # must enter at least one of (cmd, pid); ring bell
359       puts "\a"
360       return
361   }
362
363   set pcmd [list paradyn attach]
364
365   if {[string length $user] > 0} {
366     lappend pcmd "-user" $user
367   }
368
369   if {[string length $machine] > 0} {
370     lappend pcmd "-machine" $machine
371   }
372
373   if {[string length $cmd] > 0} {
374      lappend pcmd "-command" $cmd
375   }
376
377   if {[string length $pid] > 0} {
378      lappend pcmd "-pid" $pid
379   }
380
381   if {[string length $daemon] > 0} {
382     lappend pcmd "-daemon" $daemon
383   }
384
385   if {[string length $afterAttach]} {
386     lappend pcmd "-afterattach" $afterAttach
387     # 0 --> leave as is; 1 --> pause; 2 --> run
388   }
389
390   destroy $W
391
392 #puts stderr $pcmd
393
394   # Now execute it!
395   set retval [catch $pcmd result]
396
397   if {$retval == 1} {
398     eval [list uimpd showError 26 $result]
399   }
400 }