[79793] branches/gsoc11-post-destroot/base/src/port1.0/portcheckdestroot. tcl

fotanus at macports.org fotanus at macports.org
Sat Jun 25 20:15:58 PDT 2011


Revision: 79793
          http://trac.macports.org/changeset/79793
Author:   fotanus at macports.org
Date:     2011-06-25 20:15:55 -0700 (Sat, 25 Jun 2011)
Log Message:
-----------
Tested agains real ports and fixed broken checks

Major changes:
* Add self files to check for dynamic library
* Get errors form lipo and otool output
* Change whitelist to work with directories

Modified Paths:
--------------
    branches/gsoc11-post-destroot/base/src/port1.0/portcheckdestroot.tcl

Modified: branches/gsoc11-post-destroot/base/src/port1.0/portcheckdestroot.tcl
===================================================================
--- branches/gsoc11-post-destroot/base/src/port1.0/portcheckdestroot.tcl	2011-06-26 02:54:56 UTC (rev 79792)
+++ branches/gsoc11-post-destroot/base/src/port1.0/portcheckdestroot.tcl	2011-06-26 03:15:55 UTC (rev 79793)
@@ -11,7 +11,6 @@
 
 namespace eval portcheckdestroot {
 }
-
 #options
 options destroot.violate_mtree destroot.asroot depends_lib
 
@@ -34,25 +33,51 @@
     }
 }
 
+# Check if a file is binary file
+# TODO: Somewhat probabilistic. Must be a better way.
+proc portcheckdestroot::binary? filename {
+    set f [open $filename]
+    set data [read $f 1024]
+    close $f
+    expr {[string first \x00 $data]>=0}
+}
+
+
+# escape chars in order to be usable as regexp. This function is for internal use.
+proc portcheckdestroot::escape_chars {str} {
+    return [regsub {\+} $str {\+}]
+}
+
 # List all links on a directory recursively. This function is for internal use.
 proc portcheckdestroot::links_list {dir} {
     return [types_list $dir "l"]
 }
 
-# List all links on a directory recursively. This function is for internal use.
+# List all binary files on a directory recursively. This function is for internal use.
+proc portcheckdestroot::bin_list {dir} {
+    return [types_list $dir "f" 1]
+}
+
+# List all files on a directory recursively. This function is for internal use.
 proc portcheckdestroot::files_list {dir} {
     return [types_list $dir "f"]
 }
 
 # List all files of a type on a directory recursively. This function is for internal use.
-proc portcheckdestroot::types_list {dir type} {
+proc portcheckdestroot::types_list {dir type {bin 0} } {
     set ret {}
     foreach item [glob -nocomplain -type "d $type" -directory $dir *] {
         if {[file isdirectory $item]} {
             set ret [concat $ret [types_list $item $type]]
         } else {
             #is from the correct type
-            lappend ret $item
+            if { $bin } {
+                if { [binary? $item] } {
+                    lappend ret $item
+                }
+            } else {
+                lappend ret $item
+            }
         }
     }
     return $ret
@@ -199,35 +224,55 @@
 
 # Check for dynamic links that aren't in the dependency list
 proc portcheckdestroot::checkdestroot_libs {} {
-    global destroot destroot.depends_lib subport depends_lib UI_PREFIX
+    global destroot prefix UI_PREFIX subport
     ui_notice "$UI_PREFIX Checking for wrong dynamic links"
 
-    #Files that don't need to be alerted if not on dependencies.
-    #TODO: Compile these files (and move for configuration folder?)
-    set dep_whitelist {/usr/lib/libSystem.B.dylib}
+    #Folders that don't need to be alerted if not on dependencies.
+    #TODO: Compile whitelist folders
+    set dep_whitelist {/usr/lib/ /System/Library/ /lib/}
 
     #Get dependencies files list.
     set dep_files {}
     foreach dep [get_dependencies] {
         lappend dep_files [get_files [exec port contents $dep]]
     }
-    set dep_files [concat $dep_files $dep_whitelist]
+    set self_files [bin_list $destroot$prefix]
+    set dep_files [concat $dep_files $self_files]
 
     #Get package files
     foreach file [files_list $destroot] {
-        if { [file executable "$file"] } {
+        if { [binary? "$file"] } {
             #Check it dinamic links with otool
-            foreach line [split [exec -keepnewline otool -L $file] "\n"] {
-                #match they with dependency files
-                if { [regexp {\(.*} $line] } {
-                    set lib [string trim [regsub {\(.*} $line ""]]
-                    if { [regexp $lib $file] } {
-                        ui_debug "skipping, should be the file itself"
-                    } else {
-                        if { [regexp $lib [join $dep_files]] } {
-                            ui_debug "$lib binary dependency is met"
+            set otool_output [get_otool_libs $file]
+            if { $otool_output == "ignore" } {
+                ui_debug "Ignoring $file otool output"
+            } else {
+                foreach line [get_otool_libs $file] {
+                    #match they with dependency files
+                    if { [regexp {\(.*} $line] } {
+                        set lib [string trim [regsub {\(.*} $line ""]]
+                        #match against itself
+                        if { [regexp [escape_chars $lib] $file] } {
+                            ui_debug "skipping, should be the file itself"
                         } else {
-                            return -code error "$lib binary dependencies are NOT met"
+                            #match against dependencies or self files
+                            if { [regexp [escape_chars $lib] [join $dep_files]] } {
+                                ui_debug "$lib binary dependency is met"
+                            } else {
+                                #match file folder agains whitelist
+                                set found 0
+                                foreach dep $dep_whitelist {
+                                    if { [regexp "^$dep" [regsub $prefix $lib ""]] } {
+                                        set found 1
+                                        break
+                                    }
+                                }
+                                if { $found } {
+                                    ui_debug "$lib binary dependency folder is on whitelist"
+                                } else {
+                                    return -code error "$lib binary dependencies are NOT met"
+                                }
+                            }
                         }
                     }
                 }
@@ -240,12 +285,16 @@
 proc portcheckdestroot::checkdestroot_arches { archs } {
     global destroot
     foreach file [files_list $destroot] {
-        if { [file executable "$file"] } {
-            set lipo_arches [checkdestroot_get_lipo_arches $file]
+        if { [binary? "$file"] } {
+            set lipo_arches [get_lipo_arches $file]
             # Chekcs if every arch is present on the lipo output
-            foreach arch $archs {
-                if { [regexp $arch $lipo_arches] == 0 } {
-                    return -code error "$file supports the arch $arch, and should not"
+            if { $lipo_arches == "ignore" } {
+                ui_debug "Ignoring arch check for $file"
+            } else {
+                foreach arch $archs {
+                    if { [regexp $arch $lipo_arches] == 0 } {
+                        return -code error "$file supports the arch $arch, and should not"
+                    }
                 }
             }
         }
@@ -253,11 +302,21 @@
 }
 
 # Recover the arches from a file, from it's lipo output. For internal use only.
-proc portcheckdestroot::checkdestroot_get_lipo_arches { file } {
-    set lipo_output [exec lipo -info $file]
+proc portcheckdestroot::get_lipo_arches { file } {
+    if { [ catch { set lipo_output [exec lipo -info $file 2>/dev/null] } ] } {
+        return "ignore"
+    }
     return [regsub "Architectures in the.*are:" $lipo_output ""]
 }
 
+# Recover the arches from a file, from it's lipo output. For internal use only.
+proc portcheckdestroot::get_otool_libs { file } {
+    if { [ catch { set output [exec -keepnewline otool -L $file 2>/dev/null] } ] } {
+        return "ignore"
+    }
+    return [split $output "\n"]
+}
+
 # Check for arch constraints
 proc portcheckdestroot::checkdestroot_arch {} {
     global UI_PREFIX
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20110625/3db73304/attachment-0001.html>


More information about the macports-changes mailing list