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