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

Last change on this file was 151780, checked in by cal@…, 4 years ago

base: porttrace: fix modeline, reformat

Fix the broken modeline and reformat the whole file according to the modeline.
This is a whitespace only change.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 19.3 KB
Line 
1# -*- coding: utf-8; mode: tcl; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- vim:fenc=utf-8:ft=tcl:et:sw=4:ts=4:sts=4
2# porttrace.tcl
3#
4# $Id: porttrace.tcl 151780 2016-08-21 22:55:06Z cal@macports.org $
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 The MacPorts Project 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
37package require portutil 1.0
38
39namespace eval porttrace {
40    ##
41    # The fifo currently used as server socket to establish communication
42    # between traced processes and the server-side of trace mode.
43    variable fifo
44
45    ##
46    # The Tcl thread that runs the server side of trace mode and deals with
47    # requests from traced processes.
48    variable thread
49
50    ##
51    # An ordered duplicate-free list of files to which access was denied by
52    # trace mode.
53    variable sandbox_violation_list [list]
54
55    ##
56    # An ordered duplicate-free list of files inside the MacPorts prefix but
57    # unknown to MacPorts that were used by the current trace session.
58    variable sandbox_unknown_list [list]
59
60    proc appendEntry {sandbox path action} {
61        upvar 2 $sandbox sndbxlst
62
63        set mapping {}
64        # Escape backslashes with backslashes
65        lappend mapping "\\" "\\\\"
66        # Escape colons with \:
67        lappend mapping ":" "\\:"
68        # Escape equal signs with \=
69        lappend mapping "=" "\\="
70
71        # file normalize will leave symlinks as the very last
72        # path component intact. This will, for instance, prevent /tmp from
73        # being resolved to /private/tmp.
74        # Use realpath to avoid this behavior.
75        set normalizedPath [file normalize $path]
76        # realpath only works on files that exist
77        if {![catch {file type $normalizedPath}]} {
78            set normalizedPath [realpath $normalizedPath]
79        }
80        lappend sndbxlst "[string map $mapping $path]=$action"
81        if {$normalizedPath ne $path} {
82            lappend sndbxlst "[string map $mapping $normalizedPath]=$action"
83        }
84    }
85
86    ##
87    # Append a trace sandbox entry suitable for allowing access to
88    # a directory to a given sandbox list.
89    #
90    # @param sandbox The name of the sandbox list variable
91    # @param path The path that should be permitted
92    proc allow {sandbox path} {
93        appendEntry $sandbox $path "+"
94    }
95
96    ##
97    # Append a trace sandbox entry suitable for denying access to a directory
98    # (and stopping processing of the sandbox) to a given sandbox list.
99    #
100    # @param sandbox The name of the sandbox list variable
101    # @param path The path that should be denied
102    proc deny {sandbox path} {
103        appendEntry $sandbox $path "-"
104    }
105
106    ##
107    # Append a trace sandbox entry suitable for deferring the access decision
108    # back to MacPorts to query for dependencies to a given sandbox list.
109    #
110    # @param sandbox The name of the sandbox list variable
111    # @param path The path that should be handed back to MacPorts for further
112    #             processing.
113    proc ask {sandbox path} {
114        appendEntry $sandbox $path "?"
115    }
116
117    ##
118    # Start a trace mode session with the given $workpath. Creates a thread to
119    # handle requests from traced processes and sets up the sandbox bounds. You
120    # must call trace_stop once for each call to trace_start after you're done
121    # tracing processes.
122    #
123    # @param workpath The $workpath of the current installation
124    proc trace_start {workpath} {
125        global \
126            altprefix developer_dir distpath env macportsuser os.platform \
127            portpath prefix
128
129        variable fifo
130
131        if {[catch {package require Thread} error]} {
132            ui_warn "Trace mode requires Tcl Thread package ($error)"
133            return 0
134        }
135
136        # Select a name for the socket to be used to communicate with the
137        # processes being traced. Note that Unix sockets are limited to 109
138        # characters and that the the macports user must be able to connect to
139        # the socket (and in case of non-root installations, the current user,
140        # too). We're not prefixing the path in /tmp with a separate
141        # macports-specific directory, because the might not be writable by all
142        # users.
143        set fifo "/tmp/macports-trace-[pid]-[expr {int(rand() * 10000)}]"
144
145        # Make sure the socket doesn't exist yet (this would cause errors
146        # later)
147        file delete -force $fifo
148
149        # Create the server-side of the trace socket; this will handle requests
150        # from the traced processed.
151        create_slave $workpath $fifo
152
153        # Launch darwintrace.dylib.
154        set tracelib [file join ${portutil::autoconf::tcl_package_path} darwintrace1.0 darwintrace.dylib]
155
156        # Add darwintrace.dylib as last entry in DYLD_INSERT_LIBRARIES
157        if {[info exists env(DYLD_INSERT_LIBRARIES)] && [string length $env(DYLD_INSERT_LIBRARIES)] > 0} {
158            set env(DYLD_INSERT_LIBRARIES) "${env(DYLD_INSERT_LIBRARIES)}:${tracelib}"
159        } else {
160            set env(DYLD_INSERT_LIBRARIES) ${tracelib}
161        }
162        # Tell traced processes where to find their communication socket back
163        # to this code.
164        set env(DARWINTRACE_LOG) $fifo
165
166        # The sandbox is limited to:
167        set trace_sandbox [list]
168
169        # Allow work-, port-, and distpath
170        allow trace_sandbox $workpath
171        allow trace_sandbox $portpath
172        allow trace_sandbox $distpath
173
174        # Allow standard system directories
175        allow trace_sandbox "/bin"
176        allow trace_sandbox "/sbin"
177        allow trace_sandbox "/dev"
178        allow trace_sandbox "/usr/bin"
179        allow trace_sandbox "/usr/sbin"
180        allow trace_sandbox "/usr/include"
181        allow trace_sandbox "/usr/lib"
182        allow trace_sandbox "/usr/libexec"
183        allow trace_sandbox "/usr/share"
184        allow trace_sandbox "/System/Library"
185        # Deny /Library/Frameworks, third parties install there
186        deny  trace_sandbox "/Library/Frameworks"
187        # But allow the rest of /Library
188        allow trace_sandbox "/Library"
189
190        # Allow a few configuration files
191        allow trace_sandbox "/etc"
192
193        # Allow temporary locations
194        allow trace_sandbox "/tmp"
195        allow trace_sandbox "/var/tmp"
196        allow trace_sandbox "/var/folders"
197        allow trace_sandbox "/var/empty"
198        allow trace_sandbox "/var/run"
199        if {[info exists env(TMPDIR)]} {
200            set tmpdir [string trim $env(TMPDIR)]
201            if {$tmpdir ne ""} {
202                allow trace_sandbox $tmpdir
203            }
204        }
205
206        # Allow access to some Xcode specifics
207        allow trace_sandbox "/var/db/xcode_select_link"
208        allow trace_sandbox "/var/db/mds"
209        allow trace_sandbox [file normalize ~${macportsuser}/Library/Preferences/com.apple.dt.Xcode.plist]
210        allow trace_sandbox "$env(HOME)/Library/Preferences/com.apple.dt.Xcode.plist"
211
212        # Allow access to developer_dir; however, if it ends with /Contents/Developer, strip
213        # that. If it doesn't leave that in place to avoid allowing access to "/"!
214        set ddsplit [file split [file normalize [file join ${developer_dir} ".." ".."]]]
215        if {[llength $ddsplit] > 2 && [lindex $ddsplit end-1] eq "Contents" && [lindex $ddsplit end] eq "Developer"} {
216            set ddsplit [lrange $ddsplit 0 end-2]
217        }
218        allow trace_sandbox [file join {*}$ddsplit]
219
220        # Allow launchd.db access to avoid failing on port-load(1)/port-unload(1)/port-reload(1)
221        allow trace_sandbox "/var/db/launchd.db"
222
223        # Deal with ccache
224        allow trace_sandbox "$env(HOME)/.ccache"
225        if {[info exists env(CCACHE_DIR)]} {
226            set ccachedir [string trim $env(CCACHE_DIR)]
227            if {$ccachedir ne ""} {
228                allow trace_sandbox $ccachedir
229            }
230        }
231
232        # Grant access to the directory we use to mirror binaries under SIP
233        allow trace_sandbox [file join $prefix var macports sip-workaround]
234        # Defer back to MacPorts for dependency checks inside $prefix. This must be at the end,
235        # or it'll be used instead of more specific rules.
236        ask trace_sandbox $prefix
237
238        ui_debug "Tracelib Sandbox is:"
239        foreach trace_entry $trace_sandbox {
240            ui_debug "\t$trace_entry"
241        }
242
243        tracelib setsandbox [join $trace_sandbox :]
244    }
245
246    ##
247    # Stop the running trace session and clean up the trace helper thread and
248    # the communication socket. Just must call this once for each call to
249    # trace_start.
250    proc trace_stop {} {
251        global \
252            env \
253            macosx_version
254
255        variable fifo
256
257        foreach var {DYLD_INSERT_LIBRARIES DARWINTRACE_LOG} {
258            array unset env $var
259        }
260
261        # Kill socket
262        tracelib closesocket
263        tracelib clean
264        # Delete the socket file
265        file delete -force $fifo
266
267        # Delete the slave.
268        delete_slave
269    }
270
271    ##
272    # Enable the sandbox. This is only called for targets that should be run
273    # inside the sandbox.
274    proc trace_enable_fence {} {
275        tracelib enablefence
276    }
277
278    ##
279    # Print a list of sandbox violations, separated into a list of files that
280    # actually exist and were hidden, and a list of files that would have been
281    # hidden, if they existed.
282    #
283    # Also print a list of files inside the MacPorts prefix that were not
284    # installed by a port and thus not hidden, but might still cause
285    # non-repeatable builds.
286    #
287    # This method must not be called before trace_start or after trace_stop.
288    proc trace_check_violations {} {
289        # Get the list of violations and print it; separate the list into existing
290        # and non-existent files to cut down the noise.
291        set violations [slave_send porttrace::slave_get_sandbox_violations]
292
293        set existingFiles [list]
294        set missingFiles  [list]
295        foreach violation $violations {
296            if {![catch {file lstat $violation _}]} {
297                lappend existingFiles $violation
298            } else {
299                lappend missingFiles $violation
300            }
301        }
302
303        set existingFilesLen [llength $existingFiles]
304        if {$existingFilesLen > 0} {
305            if {$existingFilesLen > 1} {
306                ui_warn "The following existing files were hidden from the build system by trace mode:"
307            } else {
308                ui_warn "The following existing file was hidden from the build system by trace mode:"
309            }
310            foreach violation $existingFiles {
311                ui_msg "  $violation"
312            }
313        }
314
315        set missingFilesLen [llength $missingFiles]
316        if {$missingFilesLen > 0} {
317            if {$missingFilesLen > 1} {
318                ui_info "The following files would have been hidden from the build system by trace mode if they existed:"
319            } else {
320                ui_info "The following file would have been hidden from the build system by trace mode if it existed:"
321            }
322            foreach violation $missingFiles {
323                ui_info "  $violation"
324            }
325        }
326
327        set unknowns [slave_send porttrace::slave_get_sandbox_unknowns]
328        set existingUnknowns [list]
329        foreach unknown $unknowns {
330            if {![catch {file lstat $unknown _}]} {
331                lappend existingUnknowns $unknown
332            }
333            # We don't care about files that don't exist inside MacPorts' prefix
334        }
335
336        set existingUnknownsLen [llength $existingUnknowns]
337        if {$existingUnknownsLen > 0} {
338            if {$existingUnknownsLen > 1} {
339                ui_warn "The following files inside the MacPorts prefix not installed by a port were accessed:"
340            } else {
341                ui_warn "The following file inside the MacPorts prefix not installed by a port was accessed:"
342            }
343            foreach unknown $existingUnknowns {
344                ui_msg "  $unknown"
345            }
346        }
347    }
348
349    ##
350    # Create a thread that will contain the server-side of a macports trace
351    # mode setup. This part of the code (most of it actually implemented in
352    # pextlib1.0/tracelib.c) will create a Unix socket that all traced
353    # processes will initially connect to to get the sandbox bounds. It will
354    # also handle requests for dependency checks from traced processes and
355    # provide the appropriate answers to the client and track sandbox
356    # violations.
357    #
358    # You must call delete_slave to clean up the data structures associated
359    # with this slave thread.
360    #
361    # @param workpath The workpath of this installation
362    # @param fifo The Unix socket name to be created
363    proc create_slave {workpath fifo} {
364        global prefix developer_dir registry.path
365        variable thread
366
367        # Create the thread.
368        set thread [macports_create_thread]
369
370        # The slave thred needs this file and macports 1.0
371        thread::send $thread "package require porttrace 1.0"
372        thread::send $thread "package require macports 1.0"
373
374        # slave needs ui_{info,warn,debug,error}...
375        # make sure to sync this with ../pextlib1.0/tracelib.c!
376        thread::send $thread "macports::ui_init debug"
377        thread::send $thread "macports::ui_init info"
378        thread::send $thread "macports::ui_init warn"
379        thread::send $thread "macports::ui_init error"
380
381        # and these variables
382        thread::send $thread "set prefix \"$prefix\"; set developer_dir \"$developer_dir\""
383        # The slave thread requires the registry package.
384        thread::send $thread "package require registry 1.0"
385        # and an open registry
386        thread::send $thread "registry::open [file join ${registry.path} registry registry.db]"
387
388        # Initialize the slave
389        thread::send $thread "porttrace::slave_init $fifo $workpath"
390
391        # Run slave asynchronously
392        thread::send -async $thread "porttrace::slave_run"
393    }
394
395    ##
396    # Initialize the slave thread. This is the first user code called in the
397    # thread after creating it and setting it up.
398    #
399    # @param fifo The path of the Unix socket that should be created by
400    #             tracelib
401    # @param p_workpath The workpath of the current installation
402    proc slave_init {fifo p_workpath} {
403        variable sandbox_violation_list
404        variable sandbox_unknown_list
405
406        # Save the workpath.
407        set workpath $p_workpath
408
409        # Initialize the sandbox violation lists
410        set sandbox_violation_list {}
411        set sandbox_unknown_list {}
412
413        # Create the socket
414        tracelib setname $fifo
415        tracelib opensocket
416    }
417
418    ##
419    # Actually start the server component that will deal with requests from
420    # trace mode clients. This will occupy the thread until a different thread
421    # calls tracelib closesocket or tracelib clean.
422    proc slave_run {} {
423        tracelib run
424    }
425
426    ##
427    # Destroy the slave thread. You must call this once for each call to
428    # create_slave.
429    proc delete_slave {} {
430        variable thread
431
432        # Destroy the thread.
433        thread::release $thread
434    }
435
436    ##
437    # Send a command to the trace thread created by create_slave, wait for its
438    # completion and return its result. The behavior of this proc is undefined
439    # when called before create_slave or after delete_slave.
440    #
441    # @param command The Tcl command to be executed in the trace thread
442    # @return The return value of the Tcl command, executed in the trace thread
443    proc slave_send {command} {
444        variable thread
445
446        thread::send $thread "$command" result
447        return $result
448    }
449
450    ##
451    # Return a list of sandbox violations stored in the trace server thread.
452    #
453    # @return List of files that the traced processed tried to access but were
454    #         outside the sandbox bounds.
455    proc slave_get_sandbox_violations {} {
456        variable sandbox_violation_list
457
458        return $sandbox_violation_list
459    }
460
461    ##
462    # Add a sandbox violation. This is called directly from
463    # pextlib1.0/tracelib.c. You won't find calls to this method in Tcl code.
464    #
465    # @param path The path of the file that a traced process tried to access
466    #             but violated the sandbox bounds.
467    proc slave_add_sandbox_violation {path} {
468        variable sandbox_violation_list
469
470        sorted_list_insert sandbox_violation_list $path
471    }
472
473    ##
474    # Return a list of files accessed inside the MacPorts prefix but not
475    # registered to any port.
476    #
477    # @return List of files that the traced processed tried to access but
478    #         couldn't be matched to a port by MacPorts.
479    proc slave_get_sandbox_unknowns {} {
480        variable sandbox_unknown_list
481
482        return $sandbox_unknown_list
483    }
484
485    ##
486    # Track an access to a file within the MacPorts prefix that MacPorts
487    # doesn't know about. This is called directly from pextlib1.0/tracelib.c.
488    # You won't find calls to this method in Tcl code.
489    #
490    # @param path The path of the file that a traced process tried to access
491    #             inside the MacPorts prefix, but MacPorts couldn't match to
492    #             a port.
493    proc slave_add_sandbox_unknown {path} {
494        variable sandbox_unknown_list
495
496        sorted_list_insert sandbox_unknown_list $path
497    }
498
499    ##
500    # Insert an element into a sorted list, keeping the list sorted. If the
501    # element is already present in the list, do nothing. This should run in
502    # O(log n) to be useful.
503    proc sorted_list_insert {listname element} {
504        upvar $listname l
505
506        set rboundary [llength $l]
507        set lboundary 0
508
509        while {[set distance [expr {$rboundary - $lboundary}]] > 0} {
510            set index [expr {$lboundary + ($distance / 2)}]
511
512            set cmp [string compare $element [lindex $l $index]]
513            if {$cmp == 0} {
514                # element already present, do nothing
515                return
516            } elseif {$cmp < 0} {
517                # continue left
518                set rboundary $index
519            } else {
520                # continue right
521                set lboundary [expr {$index + 1}]
522            }
523        }
524
525        # we're at the end, lets insert here
526        set l [linsert $l $lboundary $element]
527    }
528}
Note: See TracBrowser for help on using the repository browser.