Changeset 80762

Timestamp:

07/16/11 15:21:19 (4 years ago)

Author:

cal@…

Message:

rev-upgrade: Modified Tcl code to use the new API

File:

• branches/gsoc11-rev-upgrade/base/src/macports1.0/macports.tcl (modified) (2 diffs)

branches/gsoc11-rev-upgrade/base/src/macports1.0/macports.tcl

@@ -38 +38 @@
 package require macports_index 1.0
 package require macports_util 1.0
+package require machista 1.0
 
 namespace eval macports {
@@ -3759 +3760 @@
         }
     }
+
+    set broken_files {};
     set binaries [registry::file search active 1 binary 1]
     ui_msg "---> Scanning binaries for linking errors"
-    set i 1
-    foreach b $binaries {
-        ui_debug "Scanning binary $i of [llength $binaries]: [$b path]"
-        incr i
-        # TODO: Call something, that will use 
-        # http://www.opensource.apple.com/source/cctools/cctools-800/otool/main.c
-        # as if it was called with otool -L, thus using
-        # http://www.opensource.apple.com/source/cctools/cctools-800/libstuff/ofile.c
-        # and print_libraries from
-        # http://www.opensource.apple.com/source/cctools/cctools-800/otool/ofile_print.c,
-        # but don't actually print the libs, but write them into a list and check them for existance and compatibility.
-        # Maybe implement a cache for libs that have already been checked (because a lot of software links against similar libs)
-        
-        if {[catch {set otool_output [exec /usr/bin/otool -arch all -L [$b path]]} msg]} {
-            ui_warn "Error running otool on file [$b path]: $msg"
-            continue;
-        }
-        set otool_lines [split $otool_output "\n"]
-        set arch "unknown"
-        foreach otool_line $otool_lines {
-            if {1 == [regexp -nocase {^Archive} $otool_line]} {
-                ui_info "Ignoring archive file [$b path]"
-                break;
-            }
-            if {1 == [regexp -nocase {\(architecture ([^\s]+)\)} $otool_line match arch]} {
-                switch -glob $arch {
-                    x86_64 {}
-                    i386 {}
-                    ppc* {}
-                    default {
-                        ui_warn "Unknown architecture $arch"
-                    }
-                }
+    if {[llength $binaries] > 0} {
+        set handle [machista::create_handle]
+        if {$handle == "NULL"} {
+            error "Error creating libmachista handle"
+        }
+
+        set i 1
+        foreach b $binaries {
+            ui_debug "Scanning binary $i of [llength $binaries]: [$b path]"
+            incr i
+
+            set resultlist [machista::parse_file $handle [$b path]]
+            set returncode [lindex $resultlist 0]
+            set result     [lindex $resultlist 1]
+
+            if {$returncode != $machista::SUCCESS} {
+                ui_warn "Error parsing file [$b path]: [machista::strerror $returncode]"
                 continue;
             }
-            if {$arch == "unknown"} {
-                ui_warn "Unspecified architecture in file [$b path]"
-                break;
-            }
-            if {1 == [regexp -nocase {^\t([^\s]+) \(compatibility version ([^,]+), current version ([^)]+)\)} $otool_line match file comp_version curr_version]} {
-                if {$file == [$b path]} {
-                    # library files contain themselves as their first entry in the output of otool -L
-                    continue;
-                }
-                ui_debug "Linked against: $file, architecture $arch, version $curr_version, compatibility version $comp_version"
-                if {[file exists $file]} {
-                    set lib_found false
-                    if {[catch {set lib_install_name [exec /usr/bin/otool -arch $arch -X -D $file]}] == 0} {
-                        if {[catch {set lib_otool_output [exec /usr/bin/otool -arch $arch -X -L $file]}] == 0} {
-                            set lib_otool_lines [split $lib_otool_output "\n"]
-                            foreach lib_otool_line $lib_otool_lines {
-                                if {1 == [regexp -nocase {^\t([^\s]+) \(compatibility version ([^,]+), current version ([^)]+)\)} $lib_otool_line match lib_file lib_comp_version lib_curr_version]} {
-                                    # call with -D to get install name, search for install name in -L output
-                                    if {$lib_install_name == $lib_file} {
-                                        set lib_found true
-                                        if {$curr_version != $lib_curr_version} {
-                                            if {$comp_version != $lib_comp_version} {
-                                                ui_warn "Incompatible library version of $file: Expected $comp_version, but $lib_comp_version is installed!"
-                                            }
-                                        }
-                                        break;
-                                    }
-                                }
-                            }
+
+            set architecture [$result cget -mt_archs]
+            while {$architecture != "NULL"} {
+                set loadcommand [$architecture cget -mat_loadcmds]
+
+                while {$loadcommand != "NULL"} {
+                    set libresultlist [machista::parse_file $handle [$loadcommand cget -mlt_install_name]]
+                    set libreturncode [lindex $libresultlist 0]
+                    set libresult     [lindex $libresultlist 1]
+
+                    if {$libreturncode != $machista::SUCCESS} {
+                        ui_info "Could not open `[$loadcommand cget -mlt_install_name]': [machista::strerror $libreturncode]"
+                        if {$libreturncode == $machista::EFILE} {
+                            ui_warn "Adding [$b path]"
+                            lappend broken_files [$b path]
                         }
-                    }
-                    if {$lib_found == false} {
-                        ui_warn "Missing architecture in file: $arch in $file!"
-                    }
-                } else {
-                    ui_warn "Missing dependency: $file!"
-                }
-                continue;
-            }
-            ui_warn "Unparsable line in otool output: $otool_line"
-        }
-    }
+                        set loadcommand [$loadcommand cget -next]
+                        continue;
+                    }
+
+                    set libarchitecture [$libresult cget -mt_archs]
+                    set libarch_found false;
+                    while {$libarchitecture != "NULL"} {
+                        if {[$architecture cget -mat_arch] != [$libarchitecture cget -mat_arch]} {
+                            set libarchitecture [$libarchitecture cget -next]
+                            continue;
+                        }
+
+                        if {[$loadcommand cget -mlt_version] != [$libarchitecture cget -mat_version] && [$loadcommand cget -mlt_comp_version] != [$libarchitecture cget -mat_comp_version]} {
+                            ui_info "Incompatible library version of file `[$loadcommand cget -mlt_install_name]': Expected [$loadcommand cget -mlt_comp_version], but got [$libarchitecture cget -mat_comp_version]"
+                            lappend broken_files [$architecture cget -mat_install_name]
+                        }
+
+                        set libarch_found true;
+                        break;
+                    }
+
+                    if {$libarch_found == false} {
+                        ui_info "Missing architecture [$architecture cget -mat_arch] in file `[$loadcommand cget -mlt_install_name]'"
+                        lappend broken_files [$architecture cget -mat_install_name]
+                    }
+                    set loadcommand [$loadcommand cget -next]
+                }
+
+                set architecture [$architecture cget -next]
+            }
+        }
+        machista::destroy_handle $handle
+
+        set broken_ports {}
+        ui_msg "broken files: [llength $broken_files]"
+        foreach file $broken_files {
+            ui_msg "    $file"
+            set port [registry::file_registered $file]
+            if {$port == 0} {
+                ui_error "Broken file `$file' doesn't belong to any port."
+            }
+            lappend broken_ports $port
+        }
+
+        ui_msg "broken ports: [llength $broken_ports]"
+        foreach port $broken_ports {
+            ui_msg "    $port"
+        }
+    }
+
     return 0;
 }