1 # script-loader.tcl --
2 #
3 # FIXME: This file needs a description here.
4 #
5 # Copyright (c) 1998-2002 The Regents of the University of California.
6 # All rights reserved.
7 #
8 # Redistribution and use in source and binary forms, with or without
9 # modification, are permitted provided that the following conditions are met:
10 #
11 # A. Redistributions of source code must retain the above copyright notice,
12 # this list of conditions and the following disclaimer.
13 # B. Redistributions in binary form must reproduce the above copyright notice,
14 # this list of conditions and the following disclaimer in the documentation
15 # and/or other materials provided with the distribution.
16 # C. Neither the names of the copyright holders nor the names of its
17 # contributors may be used to endorse or promote products derived from this
18 # software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
21 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23 # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
24 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
26 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
28 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
29 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30 #
31 # @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/mplug/script-loader.tcl,v 1.11 2002/02/03 04:27:54 lim Exp $
32
33
34 import WidgetClass
35 WidgetClass transparent_gif
36 import MessageBox Configuration ErrorWindow
37
38
39 Class MashScriptLoader
40
41 MashScriptLoader proc.public instance { } {
42 return [$self set instance_]
43 }
44
45
46 MashScriptLoader public init { mimetype } {
47 MashScriptLoader set instance_ $self
48 $self instvar mplug_
49 set mplug_ [new MPlug]
50 #set http_ [new HTTP]
51
52 set o [new Configuration]
53 $self optionsFrom $o
54 $o load_preferences "mplug"
55 if { ![$self confirm_download] } {
56 $self do_error "User decided not to execute script"
57 }
58
59 # on success, the following function returns NPRES_DONE which is
60 # defined to 0 in a .h file
61 # FIXME: how do I pull in constants defined in .h files into tcl?
62 if { [$mplug_ wait_for_stream] } {
63 puts stderr "Could not retrieve stream"
64 exit
65 }
66
67 if { [$mplug_ get mimetype] != $mimetype } {
68 $self do_error "The loader cannot handle mimetype:\
69 [$mplug_ get mimetype]"
70 }
71
72 set stream [$mplug_ get stream]
73 $self exec $stream
74 }
75
76
77 MashScriptLoader private exec { stream } {
78 uplevel #0 $stream
79 vwait forever
80 }
81
82
83 MashScriptLoader private do_error { msg } {
84 $self instvar mplug_
85 label .label -text $msg -justify left -anchor w
86 pack .label -fill both -expand 1 -padx 10 -pady 10
87 vwait forever
88 }
89
90
91 MashScriptLoader private confirm_download { } {
92 set r [$self get_option mash-script.run_without_asking]
93 if { $r == 1 || $r == 0 } { return $r }
94
95 # ask the use before executing the script
96 $self instvar mplug_
97 ConfirmDownloadDlg .dlg$self -image Icons(warning) -text \
98 "\nYou are about to run a MASH script that has\
99 \nbeen downloaded from the Web. This is a\
100 \npotential security risk.\
101 \nDo you want to continue?\n\n"
102
103 set retval [.dlg$self invoke]
104 if { [.dlg$self never_ask] } {
105 # set a flag in prefs-mplug
106
107 global env
108 if {![info exists env(HOME)]} {
109 new ErrorWindow \
110 {Your HOME environment variable must be set.}
111 exit 1
112 }
113 set mash [file join $env(HOME) .mash]
114 if {![file exists $mash]} {
115 file mkdir $mash
116 }
117 set f [open [file join $mash prefs-mplug] a+ 0644]
118
119 set comment "# the run_without_asking flag has the following\
120 semantics\
121 \n# 1 => always download without asking\
122 \n# 0 => never download and run\
123 \n# anything else => prompt the user"
124 puts $f "\n${comment}\nmash-script.run_without_asking: 1\n"
125 close $f
126 }
127 destroy .dlg$self
128
129 if { $retval=="yes" } { return 1 } else { return 0 }
130 }
131
132
133 MashScriptLoader public import { args } {
134 $self instvar mplug_ http_
135
136 set url_prefix [$mplug_ get url]
137 set end [string length $url_prefix]
138 if { [string index $url_prefix [expr $end-1]] != "/" } {
139 # strip the tail of the url
140 set end [string last "/" $url_prefix]
141 set url_prefix [string range $url_prefix 0 $end]
142 }
143
144 set list_of_urls {}
145 foreach entry $args {
146 lappend list_of_urls "${url_prefix}${entry}.mash"
147 }
148
149 Dialog transient MessageBox -text "List of urls '$list_of_urls'"
150 set retval [$http_ get $list_of_urls]
151 if { $retval=={} } {
152 # remove anything that might have been created inside .
153 # since we have an error
154 foreach child [winfo children .] {
155 destroy $child
156 }
157
158 $self do_error "\nImport error:\n[$http_ error]\n"
159 }
160
161 foreach script $retval {
162 uplevel #0 $script
163 }
164 }
165
166
167 WidgetClass ConfirmDownloadDlg -superclass MessageBox -default {
168 { .title "Are you sure?" }
169 { *ImageTextButton.borderWidth 1 }
170 { *Label.font WidgetDefault }
171 { *Label.wrapLength 0 }
172 { *Checkbutton.borderWidth 1 }
173 { .type yesno }
174 }
175
176
177 ConfirmDownloadDlg private build_widget { path } {
178 $self next $path
179 checkbutton $path.never_ask -anchor w -variable \
180 [$self tkvarname never_ask_] -text \
181 "Don't ask this question in the future"
182 pack $path.never_ask -fill x -side top -anchor w -padx 15 -pady 5
183 }
184
185
186 ConfirmDownloadDlg public never_ask { } {
187 $self tkvar never_ask_
188 return $never_ask_
189 }
190
191
192 #proc import { args } {
193 # eval [list [MashScriptLoader instance]] import $args
194 #}
195
196
197 new MashScriptLoader "x-mash/x-script"
198
199
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.