source: branches/gsoc11-post-destroot/base/src/port1.0/portcheckdestroot.tcl @ 79302

Last change on this file since 79302 was 79302, checked in by fotanus@…, 6 years ago

Removed _check from checkdestroot functions

It became annoying, since it already starts with check

File size: 7.2 KB
Line 
1# -*- coding: utf-8; mode: tcl; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- vim:fenc=utf-8:filetype=tcl:et:sw=4:ts=4:sts=4
2# portcheckdestroot.tcl
3
4package provide portcheckdestroot 1.0
5package require portutil 1.0
6
7set org.macports.checkdestroot [target_new org.macports.checkdestroot portcheckdestroot::checkdestroot_main]
8target_provides ${org.macports.checkdestroot} checkdestroot
9target_requires ${org.macports.checkdestroot} main destroot
10target_prerun ${org.macports.checkdestroot} portcheckdestroot::checkdestroot_start
11
12namespace eval portcheckdestroot {
13}
14
15#options
16options destroot.violate_mtree destroot.asroot
17
18#defaults
19default destroot.violate_mtree no
20
21set_ui_prefix
22
23
24# Starting procedure from checkdestroot phase. Check for permissions.
25proc portcheckdestroot::checkdestroot_start {args} {
26    if { [getuid] == 0 && [geteuid] != 0 } {
27        # if started with sudo but have dropped the privileges
28        ui_debug "Can't run destroot under sudo without elevated privileges (due to mtree)."
29        ui_debug "Run destroot without sudo to avoid root privileges."
30        ui_debug "Going to escalate privileges back to root."
31        setegid $egid
32        seteuid $euid
33        ui_debug "euid changed to: [geteuid]. egid changed to: [getegid]."
34    }
35}
36
37# List all links on a directory recursively. This function is for internal use.
38proc portcheckdestroot::links_list {dir} {
39    set ret {}
40    foreach item [glob -nocomplain -type {d l} -directory $dir *] {
41        if {[file isdirectory $item]} {
42            set ret [concat $ret [links_list $item]]
43        } else {
44            #is link
45            lappend ret $item
46        }
47    }
48    return $ret
49}
50
51# Check for errors on port symlinks
52proc portcheckdestroot::checkdestroot_symlink {} {
53    global UI_PREFIX destroot prefix
54    ui_notice "$UI_PREFIX Checking for links"
55    foreach link [links_list $destroot] {
56        set points_to [file link $link]
57        if { [string compare [file pathtype $points_to] {absolute}] == 0 } {
58            if {[regexp $destroot $points_to]} {
59                ui_debug "Absolute link path pointing to inside of destroot"
60                return -code error "Absolute link path pointing to inside of destroot"
61            } else {
62                ui_debug "Absolute link path pointing to outside of destroot"
63            }
64        } elseif { [string compare [file pathtype $points_to] {relative}] == 0 } {
65            regsub $destroot$prefix/ $link "" link_without_destroot
66            set dir_depth [regexp -all / $link_without_destroot]
67            set return_depth [regsub -all {\.\./} $points_to "" points_to_without_returns]
68            set return_delta [expr $return_depth - [regexp -all / $points_to_without_returns]]
69            if { $return_delta < $dir_depth } {
70                ui_debug "Relative link path pointing to inside of destroot"
71            } else {
72                ui_debug "Relative link path pointing to outside of destroot"
73                return -code error "Relative link path pointing to outside of destroot"
74            }
75        }
76    }
77}
78
79# Check for erros that violates the macports directory tree.
80proc portcheckdestroot::checkdestroot_mtree {} {
81
82    global destroot prefix portsharepath destroot.violate_mtree
83    global os.platform applications_dir frameworks_dir
84    global UI_PREFIX
85
86    set mtree [findBinary mtree ${portutil::autoconf::mtree_path}]
87
88    # test for violations of mtree
89    if { ${destroot.violate_mtree} != "yes" } {
90        ui_notice "$UI_PREFIX Executing mtree check"
91        ui_debug "checking for mtree violations"
92        set mtree_violation "no"
93
94        set prefixPaths [list bin etc include lib libexec sbin share src var www Applications Developer Library]
95
96        set pathsToCheck [list /]
97        while {[llength $pathsToCheck] > 0} {
98            set pathToCheck [lshift pathsToCheck]
99            foreach file [glob -nocomplain -directory $destroot$pathToCheck .* *] {
100                if {[file tail $file] eq "." || [file tail $file] eq ".."} {
101                    continue
102                }
103                if {[string equal -length [string length $destroot] $destroot $file]} {
104                    # just double-checking that $destroot is a prefix, as is appropriate
105                    set dfile [file join / [string range $file [string length $destroot] end]]
106                } else {
107                    throw MACPORTS "Unexpected filepath `${file}' while checking for mtree violations"
108                }
109                if {$dfile eq $prefix} {
110                    # we've found our prefix
111                    foreach pfile [glob -nocomplain -tails -directory $file .* *] {
112                        if {$pfile eq "." || $pfile eq ".."} {
113                            continue
114                        }
115                        if {[lsearch -exact $prefixPaths $pfile] == -1} {
116                            ui_warn "violation by [file join $dfile $pfile]"
117                            set mtree_violation "yes"
118                        }
119                    }
120                } elseif {[string equal -length [expr [string length $dfile] + 1] $dfile/ $prefix]} {
121                    # we've found a subpath of our prefix
122                    lpush pathsToCheck $dfile
123                } else {
124                    set dir_allowed no
125                    # these files are (at least potentially) outside of the prefix
126                    foreach dir "$applications_dir $frameworks_dir /Library/LaunchAgents /Library/LaunchDaemons /Library/StartupItems" {
127                        if {[string equal -length [expr [string length $dfile] + 1] $dfile/ $dir]} {
128                            # it's a prefix of one of the allowed paths
129                            set dir_allowed yes
130                            break
131                        }
132                    }
133                    if {$dir_allowed} {
134                        lpush pathsToCheck $dfile
135                    } else {
136                        # not a prefix of an allowed path, so it's either the path itself or a violation
137                        switch -- $dfile \
138                            $applications_dir - \
139                            $frameworks_dir - \
140                            /Library/LaunchAgents - \
141                            /Library/LaunchDaemons - \
142                            /Library/StartupItems { ui_debug "port installs files in $dfile" } \
143                            default {
144                                ui_warn "violation by $dfile"
145                                set mtree_violation "yes"
146                            }
147                    }
148                }
149            }
150        }
151
152        # abort here only so all violations can be observed
153        if { ${mtree_violation} != "no" } {
154            ui_warn "[format [msgcat::mc "%s violates the layout of the ports-filesystems!"] [option subport]]"
155            ui_warn "Please fix or indicate this misbehavior (if it is intended), it will be an error in future releases!"
156            # error "mtree violation!"
157        }
158    } else {
159        ui_warn "[format [msgcat::mc "%s installs files outside the common directory structure."] [option subport]]"
160    }
161}
162
163proc portcheckdestroot::checkdestroot_main {args} {
164    global UI_PREFIX
165    ui_notice "$UI_PREFIX Executing check-destroot phase"
166
167    checkdestroot_symlink
168    checkdestroot_mtree
169    return 0
170}
Note: See TracBrowser for help on using the repository browser.