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

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

Allow /private/var/tmp, too.

  • 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.20 2006/07/25 08:50:48 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 file 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.