source: trunk/base/src/port1.0/porttrace.tcl @ 18781

Last change on this file since 18781 was 18781, checked in by pguyot (Paul Guyot), 14 years ago

darwintrace now reports creation of directories outside the sandbox.
It works with rb-rubygems. Cf:
http://bugzilla.opendarwin.org/show_bug.cgi?id=5491

  • Property svn:eol-style set to native
File size: 8.7 KB
Line 
1# et:ts=4
2# porttrace.tcl
3#
4# $Id: porttrace.tcl,v 1.21 2006/07/28 10:11:10 pguyot Exp $
5#
6# Copyright (c) 2005-2006 Paul Guyot <pguyot@kallisys.net>,
7# All rights reserved.
8#
9# Redistribution and use in source and binary forms, with or without
10# modification, are permitted provided that the following conditions are
11# met:
12#
13# 1. Redistributions of source code must retain the above copyright
14#    notice, this list of conditions and the following disclaimer.
15# 2. Redistributions in binary form must reproduce the above copyright
16#    notice, this list of conditions and the following disclaimer in the
17#    documentation and/or other materials provided with the distribution.
18# 3. Neither the name of Apple Computer, Inc. nor the names of its
19#    contributors may be used to endorse or promote products derived from
20#    this software without specific prior written permission.
21#
22# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
23# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
24# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
25# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
26# OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
27# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
28# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
29# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
30# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
31# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
32# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
33#
34
35package provide porttrace 1.0
36package require Pextlib 1.0
37
38proc trace_start {workpath} {
39        global os.platform
40        if {${os.platform} == "darwin"} {
41                if {[catch {package require Thread} error]} {
42                        ui_warn "trace requires Tcl Thread package ($error)"
43                } else {
44                        global env trace_fifo trace_sandboxbounds
45                        # Create a fifo.
46                        set trace_fifo "$workpath/trace_fifo"
47                        file delete -force $trace_fifo
48                        mkfifo $trace_fifo 0600
49                       
50                        # Create the thread/process.
51                        create_slave $workpath $trace_fifo
52                                       
53                        # Launch darwintrace.dylib.
54                       
55                        set env(DYLD_INSERT_LIBRARIES) \
56                                [file join ${portutil::autoconf::prefix} share darwinports Tcl darwintrace1.0 darwintrace.dylib]
57                        set env(DYLD_FORCE_FLAT_NAMESPACE) 1
58                        set env(DARWINTRACE_LOG) "$trace_fifo"
59                        # The sandbox is limited to:
60                        # workpath
61                        # /tmp
62                        # /private/tmp
63                        # /var/tmp
64                        # /private/var/tmp
65                        # $TMPDIR
66                        # /dev/null
67                        # /dev/tty
68                        set trace_sandboxbounds "/tmp:/private/tmp:/var/tmp:/private/var/tmp:/dev/null:/dev/tty:${workpath}"
69                        if {[info exists env(TMPDIR)]} {
70                                set trace_sandboxbounds "${trace_sandboxbounds}:$env(TMPDIR)"
71                        }
72                }
73        }
74}
75
76# Enable the fence.
77# Only done for targets that should only happen in the sandbox.
78proc trace_enable_fence {} {
79        global env trace_sandboxbounds
80        set env(DARWINTRACE_SANDBOX_BOUNDS) $trace_sandboxbounds       
81}
82
83# Disable the fence.
84# Unused yet.
85proc trace_disable_fence {} {
86        global env
87        if [info exists env(DARWINTRACE_SANDBOX_BOUNDS)] {
88                unset env(DARWINTRACE_SANDBOX_BOUNDS)
89        }
90}
91
92# Check the list of ports.
93# Output a warning for every port the trace revealed a dependency on
94# that isn't included in portslist
95# This method must be called after trace_start
96proc trace_check_deps {target portslist} {
97        # Get the list of ports.
98        set ports [slave_send slave_get_ports]
99       
100        # Compare with portslist
101        set portslist [lsort $portslist]
102        foreach port $ports {
103                if {[lsearch -sorted -exact $portslist $port] == -1} {
104                        ui_warn "Target $target has an undeclared dependency on $port"
105                }
106        }
107        foreach port $portslist {
108                if {[lsearch -sorted -exact $ports $port] == -1} {
109                        ui_debug "Target $target has no traceable dependency on $port"
110                }
111        }       
112}
113
114# Check that no violation happened.
115# Output a warning for every sandbox violation the trace revealed.
116# This method must be called after trace_start
117proc trace_check_violations {} {
118        # Get the list of violations.
119        set violations [slave_send slave_get_sandbox_violations]
120       
121        foreach violation [lsort $violations] {
122                ui_warn "A creation/deletion/modification was attempted outside sandbox: $violation"
123        }
124}
125
126# Stop the trace and return the list of ports the port depends on.
127# This method must be called after trace_start
128proc trace_stop {} {
129        global os.platform
130        if {${os.platform} == "darwin"} {
131                global env trace_fifo
132                unset env(DYLD_INSERT_LIBRARIES)
133                unset env(DYLD_FORCE_FLAT_NAMESPACE)
134                unset env(DARWINTRACE_LOG)
135                if [info exists env(DARWINTRACE_SANDBOX_BOUNDS)] {
136                        unset env(DARWINTRACE_SANDBOX_BOUNDS)
137                }
138
139                # Clean up.
140                slave_send slave_stop
141
142                # Delete the slave.
143                delete_slave
144
145                file delete -force $trace_fifo
146        }
147}
148
149# Private
150# Create the slave thread.
151proc create_slave {workpath trace_fifo} {
152        global trace_thread
153        # Create the thread.
154        set trace_thread [darwinports_create_thread]
155       
156        # The slave thread requires the registry package.
157        thread::send -async $trace_thread "package require registry 1.0"
158        # and this file as well.
159        thread::send -async $trace_thread "package require porttrace 1.0"
160
161        # Start the slave work.
162        thread::send -async $trace_thread "slave_start $trace_fifo $workpath"
163}
164
165# Private
166# Send a command to the thread without waiting for the result.
167proc slave_send_async {command} {
168        global trace_thread
169
170        thread::send -async $trace_thread "$command"
171}
172
173# Private
174# Send a command to the thread.
175proc slave_send {command} {
176        global trace_thread
177
178        thread::send $trace_thread "$command" result
179        return $result
180}
181
182# Private
183# Destroy the thread.
184proc delete_slave {} {
185        global trace_thread
186
187        # Destroy the thread.
188        thread::release $trace_thread
189}
190
191# Private.
192# Slave method to read a line from the trace.
193proc slave_read_line {chan} {
194        global ports_list trace_filemap sandbox_violation_list workpath
195        global env
196
197        while 1 {
198                # We should never get EOF, actually.
199                if {[eof $chan]} {
200                        break
201                }
202               
203                # The line is of the form: verb\tpath
204                # Get the path by chopping it.
205                set theline [gets $chan]
206               
207                if {[fblocked $chan]} {
208                        # Exit the loop.
209                        break
210                }
211
212                set line_length [string length $theline]
213               
214                # Skip empty lines.
215                if {$line_length > 0} {
216                        set path_start [expr [string first "\t" $theline] + 1]
217                        set op [string range $theline 0 [expr $path_start - 2]]
218                        set path [string range $theline $path_start [expr $line_length - 1]]
219                       
220                        # open/execve
221                        if {$op == "open" || $op == "execve"} {
222                                # Only work on files.
223                                if {[file isfile $path]} {
224                                        # Did we process the file yet?
225                                        if {![filemap exists trace_filemap $path]} {
226                                                # Obtain information about this file.
227                                                set port [registry::file_registered $path]
228                                                if { $port != 0 } {
229                                                        # Add the port to the list.
230                                                        if {[lsearch -sorted -exact $ports_list $port] == -1} {
231                                                                lappend ports_list $port
232                                                                set ports_list [lsort $ports_list]
233                                                                # Maybe fill trace_filemap for efficiency?
234                                                        }
235                                                }
236                       
237                                                # Add the file to the tree with port information.
238                                                # Ignore errors. Errors can occur if a directory was
239                                                # created where a file once lived.
240                                                # This doesn't affect existing ports and we just
241                                                # add this information to speed up port detection.
242                                                catch {filemap set trace_filemap $path $port}
243                                        }
244                                }
245                        } elseif {$op == "sandbox_violation"} {
246                                lappend sandbox_violation_list $path
247                        }
248                }
249        }
250}
251
252# Private.
253# Slave init method.
254proc slave_start {fifo p_workpath} {
255        global ports_list trace_filemap sandbox_violation_list trace_fifo_r_chan \
256                trace_fifo_w_chan workpath
257        # Save the workpath.
258        set workpath $p_workpath
259        # Create a virtual filemap.
260        filemap create trace_filemap
261        set ports_list {}
262        set sandbox_violation_list {}
263        set trace_fifo_r_chan [open $fifo {RDONLY NONBLOCK}]
264        # To prevent EOF when darwintrace closes the file, I also open the pipe
265        # myself as write only.
266        # This is quite ugly. The clean way to do would be to only install the
267        # fileevent handler when the pipe is opened on the other end, but I don't
268        # know how to wait for this while still being interruptable (i.e. while
269        # still being able to get commands thru thread::send). Thoughts, anyone?
270        set trace_fifo_w_chan [open $fifo w]
271        fconfigure $trace_fifo_r_chan -blocking 0 -buffering line
272        fileevent $trace_fifo_r_chan readable [list slave_read_line $trace_fifo_r_chan]
273}
274
275# Private.
276# Slave cleanup method.
277proc slave_stop {} {
278        global trace_filemap trace_fifo_r_chan trace_fifo_w_chan
279        # Close the virtual filemap.
280        filemap close trace_filemap
281        # Close the pipe (both ends).
282        close $trace_fifo_r_chan
283        close $trace_fifo_w_chan
284}
285
286# Private.
287# Slave ports export method.
288proc slave_get_ports {} {
289        global ports_list
290        return $ports_list
291}
292
293# Private.
294# Slave sandbox violations export method.
295proc slave_get_sandbox_violations {} {
296        global sandbox_violation_list
297        return $sandbox_violation_list
298}
Note: See TracBrowser for help on using the repository browser.