[50563] branches/images-and-archives/base
blb at macports.org
blb at macports.org
Sun May 3 23:22:28 PDT 2009
Revision: 50563
http://trac.macports.org/changeset/50563
Author: blb at macports.org
Date: 2009-05-03 23:22:25 -0700 (Sun, 03 May 2009)
Log Message:
-----------
Merge from trunk
Modified Paths:
--------------
branches/images-and-archives/base/portmgr/bots/trac.rb
branches/images-and-archives/base/src/macports1.0/macports.tcl
branches/images-and-archives/base/src/package1.0/portarchive.tcl
branches/images-and-archives/base/src/package1.0/portmpkg.tcl
branches/images-and-archives/base/src/package1.0/portunarchive.tcl
branches/images-and-archives/base/src/port/port.tcl
branches/images-and-archives/base/src/port1.0/portbuild.tcl
branches/images-and-archives/base/src/port1.0/portchecksum.tcl
branches/images-and-archives/base/src/port1.0/portclean.tcl
branches/images-and-archives/base/src/port1.0/portconfigure.tcl
branches/images-and-archives/base/src/port1.0/portdepends.tcl
branches/images-and-archives/base/src/port1.0/portdestroot.tcl
branches/images-and-archives/base/src/port1.0/portdistcheck.tcl
branches/images-and-archives/base/src/port1.0/portextract.tcl
branches/images-and-archives/base/src/port1.0/portfetch.tcl
branches/images-and-archives/base/src/port1.0/portlivecheck.tcl
branches/images-and-archives/base/src/port1.0/portmirror.tcl
branches/images-and-archives/base/src/port1.0/portpatch.tcl
branches/images-and-archives/base/src/port1.0/portsubmit.tcl
branches/images-and-archives/base/src/port1.0/porttest.tcl
branches/images-and-archives/base/src/port1.0/porttrace.tcl
branches/images-and-archives/base/src/port1.0/portutil.tcl
Property Changed:
----------------
branches/images-and-archives/base/
Property changes on: branches/images-and-archives/base
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/gsoc08-privileges/base:37343-46937
/branches/variant-descs-14482/base:34469-34855,34900-37508,37511-37512,41040-41463,42575-42626,42640-42659
/trunk/base:50249-50379
/users/perry/base-bugs_and_notes:45682-46060
/users/perry/base-select:44044-44692
+ /branches/gsoc08-privileges/base:37343-46937
/branches/variant-descs-14482/base:34469-34855,34900-37508,37511-37512,41040-41463,42575-42626,42640-42659
/trunk/base:50249-50562
/users/perry/base-bugs_and_notes:45682-46060
/users/perry/base-select:44044-44692
Modified: branches/images-and-archives/base/portmgr/bots/trac.rb
===================================================================
--- branches/images-and-archives/base/portmgr/bots/trac.rb 2009-05-04 04:15:01 UTC (rev 50562)
+++ branches/images-and-archives/base/portmgr/bots/trac.rb 2009-05-04 06:22:25 UTC (rev 50563)
@@ -48,9 +48,14 @@
end
end
+ def team(m, params)
+ m.reply "http://trac.macports.org/wiki/MacPortsDevelopers"
+ end
+
end
plugin = TracPlugin.new
plugin.map 'ticket :number', :action => 'ticket'
-plugin.map 'faq :parm', :action => 'faq'
-plugin.map 'guide :parm', :action => 'guide'
\ No newline at end of file
+plugin.map 'faq :parm', :action => 'faq', :defaults => {:parm => ""}
+plugin.map 'guide :parm', :action => 'guide', :defaults => {:parm => ""}
+plugin.map 'team', :action => 'team'
\ No newline at end of file
Modified: branches/images-and-archives/base/src/macports1.0/macports.tcl
===================================================================
--- branches/images-and-archives/base/src/macports1.0/macports.tcl 2009-05-04 04:15:01 UTC (rev 50562)
+++ branches/images-and-archives/base/src/macports1.0/macports.tcl 2009-05-04 06:22:25 UTC (rev 50563)
@@ -2108,9 +2108,9 @@
proc macports::upgrade {portname dspec globalvarlist variationslist optionslist {depscachename ""}} {
array set options $optionslist
- # Note $variationslist is left alone and so retains the original
+ # Note $variationslist is left alone and so retains the original
# requested variations, which should be passed to recursive calls to
- # upgrade; while variations gets existing variants and global variations
+ # upgrade; while variations gets existing variants and global variations
# merged in later on, so it applies only to this port's upgrade
array set variations $variationslist
@@ -2118,8 +2118,6 @@
upvar $depscachename depscache
}
- # set to 1 if epoch overrides version
- set epoch_override 0
# Is this a dry run?
set is_dryrun no
if {[info exists options(ports_dryrun)] && $options(ports_dryrun) eq "yes"} {
@@ -2161,22 +2159,22 @@
if {![info exists porturl]} {
set porturl file://./
}
- # Merge the global variations into the specified
- foreach { variation value } $globalvarlist {
- if { ![info exists variations($variation)] } {
- set variations($variation) $value
- }
- }
-
- if {[catch {set workername [mportopen $porturl [array get options] [array get variations]]} result]} {
+ # Merge the global variations into the specified
+ foreach { variation value } $globalvarlist {
+ if { ![info exists variations($variation)] } {
+ set variations($variation) $value
+ }
+ }
+
+ if {[catch {set workername [mportopen $porturl [array get options] [array get variations]]} result]} {
global errorInfo
ui_debug "$errorInfo"
ui_error "Unable to open port: $result"
return 1
}
- # While we're at it, update the portinfo
- array unset portinfo
- array set portinfo [mportinfo $workername]
+ # While we're at it, update the portinfo
+ array unset portinfo
+ array set portinfo [mportinfo $workername]
if {![_mportispresent $workername $dspec ] } {
# upgrade its dependencies first
@@ -2189,8 +2187,8 @@
return 1
}
if {$result > 0} {
- ui_error "Problem while installing $portname"
- return $result
+ ui_error "Problem while installing $portname"
+ return $result
}
# we just installed it, so mark it done in the cache
# and update ilist
@@ -2254,65 +2252,65 @@
ui_debug "no version of $portname is active"
}
- # save existing variant for later use
- if {$anyactive} {
- set oldvariant $variant_active
- } else {
- set oldvariant $variant_installed
- }
+ # save existing variant for later use
+ if {$anyactive} {
+ set oldvariant $variant_active
+ } else {
+ set oldvariant $variant_installed
+ }
- # Before we do
- # dependencies, we need to figure out the final variants,
- # open the port, and update the portinfo.
+ # Before we do
+ # dependencies, we need to figure out the final variants,
+ # open the port, and update the portinfo.
- set porturl $portinfo(porturl)
- if {![info exists porturl]} {
- set porturl file://./
- }
+ set porturl $portinfo(porturl)
+ if {![info exists porturl]} {
+ set porturl file://./
+ }
- # check if the variants is present in $version_in_tree
- set variant [split $oldvariant +]
- ui_debug "Merging existing variants $variant into variants"
- if {[info exists portinfo(variants)]} {
- set avariants $portinfo(variants)
- } else {
- set avariants {}
- }
- ui_debug "available variants are : $avariants"
- foreach v $variant {
- if {[lsearch $avariants $v] == -1} {
- } else {
- ui_debug "variant $v is present in $portname $version_in_tree"
- if { ![info exists variations($v)]} {
- set variations($v) "+"
- }
- }
- }
+ # check if the variants is present in $version_in_tree
+ set variant [split $oldvariant +]
+ ui_debug "Merging existing variants $variant into variants"
+ if {[info exists portinfo(variants)]} {
+ set avariants $portinfo(variants)
+ } else {
+ set avariants {}
+ }
+ ui_debug "available variants are : $avariants"
+ foreach v $variant {
+ if {[lsearch $avariants $v] == -1} {
+ } else {
+ ui_debug "variant $v is present in $portname $version_in_tree"
+ if { ![info exists variations($v)]} {
+ set variations($v) "+"
+ }
+ }
+ }
- # Now merge in the global (i.e. variants.conf) variations.
- # We wait until now so that existing variants for this port
- # override global variations
- foreach { variation value } $globalvarlist {
- if { ![info exists variations($variation)] } {
- set variations($variation) $value
- }
- }
+ # Now merge in the global (i.e. variants.conf) variations.
+ # We wait until now so that existing variants for this port
+ # override global variations
+ foreach { variation value } $globalvarlist {
+ if { ![info exists variations($variation)] } {
+ set variations($variation) $value
+ }
+ }
- ui_debug "new fully merged portvariants: [array get variations]"
+ ui_debug "new fully merged portvariants: [array get variations]"
- if {[catch {set workername [mportopen $porturl [array get options] [array get variations]]} result]} {
- global errorInfo
- ui_debug "$errorInfo"
- ui_error "Unable to open port: $result"
- return 1
- }
+ if {[catch {set workername [mportopen $porturl [array get options] [array get variations]]} result]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error "Unable to open port: $result"
+ return 1
+ }
- array unset portinfo
- array set portinfo [mportinfo $workername]
- set portwasopened 1
- set version_in_tree "$portinfo(version)"
- set revision_in_tree "$portinfo(revision)"
- set epoch_in_tree "$portinfo(epoch)"
+ array unset portinfo
+ array set portinfo [mportinfo $workername]
+ set portwasopened 1
+ set version_in_tree "$portinfo(version)"
+ set revision_in_tree "$portinfo(revision)"
+ set epoch_in_tree "$portinfo(epoch)"
# first upgrade dependencies
@@ -2322,6 +2320,7 @@
ui_debug "Not following dependencies"
}
+ set epoch_override 0
# check installed version against version in ports
if { ( [rpm-vercomp $version_installed $version_in_tree] > 0
|| ([rpm-vercomp $version_installed $version_in_tree] == 0
@@ -2353,25 +2352,28 @@
return 0
} else {
+ set epoch_override 1
ui_debug "epoch override ... upgrading!"
- set epoch_override 1
}
}
- # install version_in_tree
+ # build or unarchive version_in_tree
set upgrade_action "archive"
- if {[catch {set result [mportexec $workername $upgrade_action]} result] || $result != 0} {
- global errorInfo
- ui_debug "$errorInfo"
- ui_error "Unable to upgrade port: $result"
- return 1
+ # avoid building again unnecessarily
+ if {[info exists options(ports_force)] || $epoch_override == 1
+ || ![registry::entry_exists $portname $version_in_tree $revision_in_tree $portinfo(canonical_active_variants)]} {
+ if {[catch {set result [mportexec $workername $upgrade_action]} result] || $result != 0} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error "Unable to upgrade port: $result"
+ return 1
+ }
}
# are we installing an existing version due to force or epoch override?
- if {([info exists options(ports_force)] || $epoch_override == 1)
- && [registry::entry_exists $portname $version_in_tree $revision_in_tree $portinfo(canonical_active_variants)]} {
+ if {[registry::entry_exists $portname $version_in_tree $revision_in_tree $portinfo(canonical_active_variants)]} {
ui_debug "Uninstalling $portname ${version_in_tree}_${revision_in_tree}$portinfo(canonical_active_variants)"
# we have to force the uninstall in case of dependents
set force_cur [info exists options(ports_force)]
Modified: branches/images-and-archives/base/src/package1.0/portarchive.tcl
===================================================================
--- branches/images-and-archives/base/src/package1.0/portarchive.tcl 2009-05-04 04:15:01 UTC (rev 50562)
+++ branches/images-and-archives/base/src/package1.0/portarchive.tcl 2009-05-04 06:22:25 UTC (rev 50563)
@@ -37,7 +37,7 @@
set org.macports.archive [target_new org.macports.archive portarchive::archive_main]
target_init ${org.macports.archive} portarchive::archive_init
target_provides ${org.macports.archive} archive
-target_requires ${org.macports.archive} main fetch extract checksum patch configure build destroot
+target_requires ${org.macports.archive} main unarchive fetch extract checksum patch configure build destroot
target_prerun ${org.macports.archive} portarchive::archive_start
target_postrun ${org.macports.archive} portarchive::archive_finish
@@ -102,15 +102,24 @@
set skipped 1
} else {
set unsupported 0
+ set any_missing no
foreach archive.type [option portarchivetype] {
if {[catch {archiveTypeIsSupported ${archive.type}} errmsg] == 0} {
set archive.file "${portname}-${portversion}_${portrevision}${portvariants}.[option os.arch].${archive.type}"
set archive.path "[file join ${archive.fulldestpath} ${archive.file}]"
+ if {![file exists ${archive.path}]} {
+ set any_missing yes
+ }
} else {
ui_debug "Skipping [string toupper ${archive.type}] archive: $errmsg"
set unsupported [expr $unsupported + 1]
}
}
+ if {!$any_missing} {
+ # might be nice to allow forcing, but let's fix #16061 first
+ ui_debug "Skipping archive ($portname) since archive(s) already exist"
+ set skipped 1
+ }
if {${archive.type} == "xpkg"} {
set archive.meta true
}
Modified: branches/images-and-archives/base/src/package1.0/portmpkg.tcl
===================================================================
--- branches/images-and-archives/base/src/package1.0/portmpkg.tcl 2009-05-04 04:15:01 UTC (rev 50562)
+++ branches/images-and-archives/base/src/package1.0/portmpkg.tcl 2009-05-04 06:22:25 UTC (rev 50563)
@@ -60,7 +60,7 @@
if {[catch {set res [mport_lookup $portname]} error]} {
global errorInfo
ui_debug "$errorInfo"
- ui_error "port search failed: $error"
+ ui_error "port lookup failed: $error"
return 1
}
foreach {name array} $res {
@@ -94,7 +94,7 @@
if {[catch {set res [mport_lookup $portname]} result]} {
global errorInfo
ui_debug "$errorInfo"
- ui_error "port search failed: $result"
+ ui_error "port lookup failed: $result"
return 1
}
foreach {name array} $res {
Modified: branches/images-and-archives/base/src/package1.0/portunarchive.tcl
===================================================================
--- branches/images-and-archives/base/src/package1.0/portunarchive.tcl 2009-05-04 04:15:01 UTC (rev 50562)
+++ branches/images-and-archives/base/src/package1.0/portunarchive.tcl 2009-05-04 06:22:25 UTC (rev 50563)
@@ -303,9 +303,6 @@
# Update the state from unpacked archive version
set target_state_fd [open_statefile]
-
- # Archive unpacked, skip archive target
- write_statefile target "org.macports.archive" $target_state_fd
# Cleanup all control files when finished
set control_files [glob -nocomplain -types f [file join $destpath +*]]
Modified: branches/images-and-archives/base/src/port/port.tcl
===================================================================
--- branches/images-and-archives/base/src/port/port.tcl 2009-05-04 04:15:01 UTC (rev 50562)
+++ branches/images-and-archives/base/src/port/port.tcl 2009-05-04 06:22:25 UTC (rev 50563)
@@ -369,9 +369,9 @@
}
uplevel 1 $block
if {[file exists $savedir]} {
- cd $savedir
+ cd $savedir
} else {
- cd ~
+ cd ~
}
}
}
@@ -1336,15 +1336,15 @@
return 0
}
- if {[file exists $helpfile]} {
- if {[catch {source $helpfile} err]} {
- puts stderr "Error reading helpfile $helpfile: $err"
- return 1
- }
+ if {[file exists $helpfile]} {
+ if {[catch {source $helpfile} err]} {
+ puts stderr "Error reading helpfile $helpfile: $err"
+ return 1
+ }
} else {
- puts stderr "Unable to open help file $helpfile"
- return 1
- }
+ puts stderr "Unable to open help file $helpfile"
+ return 1
+ }
foreach topic $portlist {
if {![info exists porthelp($topic)]} {
@@ -2076,14 +2076,14 @@
global errorInfo
ui_debug "$errorInfo"
- # start gsoc08-privileges
- if { [string first "permission denied" $result] != -1 } {
- set result "port requires root privileges for this action and needs you to execute 'sudo port uninstall $portname' to continue."
- #ui_msg [exec sudo port uninstall $portname]
- # The above line is what should be here to let the user simply enter his/her password to uninstall as root.
- # However, for some as yet unknown reason, executing it here will not work.
- }
- # end gsoc08-privileges
+ # start gsoc08-privileges
+ if { [string first "permission denied" $result] != -1 } {
+ set result "port requires root privileges for this action and needs you to execute 'sudo port uninstall $portname' to continue."
+ #ui_msg [exec sudo port uninstall $portname]
+ # The above line is what should be here to let the user simply enter his/her password to uninstall as root.
+ # However, for some as yet unknown reason, executing it here will not work.
+ }
+ # end gsoc08-privileges
break_softcontinue "port uninstall failed: $result" 1 status
}
@@ -2846,23 +2846,23 @@
mportclose $workername
# start gsoc08-privileges
- if { [geteuid] != 0 && $result == 2} {
- # mportexec will return an error result code 2 if eval_targets fails due to insufficient privileges.
+ if { [geteuid] != 0 && $result == 2} {
+ # mportexec will return an error result code 2 if eval_targets fails due to insufficient privileges.
- set portbinary "${macports::prefix}/bin/port"
-
- ui_info "Attempting port action with 'sudo port': 'sudo $portbinary $target $portname'."
- set result 0
- if {[catch {set sudomsgs [exec sudo $portbinary $target $portname]} sudomsgs]} {
- global errorInfo
- ui_debug "$errorInfo"
- break_softcontinue "Unable to execute port: $errorInfo" 1 status
- }
-
- ui_msg $sudomsgs
- ui_debug "'sudo $portbinary $target $portname' has completed."
- }
- # end gsoc08-privileges
+ set portbinary "${macports::prefix}/bin/port"
+
+ ui_info "Attempting port action with 'sudo port': 'sudo $portbinary $target $portname'."
+ set result 0
+ if {[catch {set sudomsgs [exec sudo $portbinary $target $portname]} sudomsgs]} {
+ global errorInfo
+ ui_debug "$errorInfo"
+ break_softcontinue "Unable to execute port: $errorInfo" 1 status
+ }
+
+ ui_msg $sudomsgs
+ ui_debug "'sudo $portbinary $target $portname' has completed."
+ }
+ # end gsoc08-privileges
# Process any error that wasn't thrown and handled already
if {$result} {
Modified: branches/images-and-archives/base/src/port1.0/portbuild.tcl
===================================================================
--- branches/images-and-archives/base/src/port1.0/portbuild.tcl 2009-05-04 04:15:01 UTC (rev 50562)
+++ branches/images-and-archives/base/src/port1.0/portbuild.tcl 2009-05-04 06:22:25 UTC (rev 50563)
@@ -16,7 +16,7 @@
# 3. Neither the name of Apple Computer, Inc. nor the names of its contributors
# may be used to endorse or promote products derived from this software
# without specific prior written permission.
-#
+#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
@@ -86,11 +86,11 @@
pbx {
set pbxbuild "pbxbuild"
set xcodebuild "xcodebuild"
-
+
if {[option os.platform] != "darwin"} {
return -code error "[format [msgcat::mc "This port requires 'pbxbuild/xcodebuild', which is not available on %s."] [option os.platform]]"
}
-
+
if {[catch {set xcodebuild [binaryInPath $xcodebuild]}] == 0} {
return $xcodebuild
} elseif {[catch {set pbxbuild [binaryInPath $pbxbuild]}] == 0} {
@@ -141,16 +141,16 @@
proc portbuild::build_start {args} {
global UI_PREFIX build.asroot
-
+
ui_msg "$UI_PREFIX [format [msgcat::mc "Building %s"] [option portname]]"
-
+
# start gsoc08-privileges
if { [tbool build.asroot] } {
- # if port is marked as needing root
- elevateToRoot "build"
- }
- # end gsoc08-privileges
-
+ # if port is marked as needing root
+ elevateToRoot "build"
+ }
+ # end gsoc08-privileges
+
}
proc portbuild::build_main {args} {
Modified: branches/images-and-archives/base/src/port1.0/portchecksum.tcl
===================================================================
--- branches/images-and-archives/base/src/port1.0/portchecksum.tcl 2009-05-04 04:15:01 UTC (rev 50562)
+++ branches/images-and-archives/base/src/port1.0/portchecksum.tcl 2009-05-04 06:22:25 UTC (rev 50563)
@@ -17,7 +17,7 @@
# 3. Neither the name of Apple Computer, Inc. nor the names of its contributors
# may be used to endorse or promote products derived from this software
# without specific prior written permission.
-#
+#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
@@ -61,8 +61,8 @@
# global array checksums_array.
#
# There are two formats:
-# type value [type value [type value]] for a single file
-# file1 type value [type value [type value]] [file2 ...] for multiple files.
+# type value [type value [type value]] for a single file
+# file1 type value [type value [type value]] [file2 ...] for multiple files.
#
# Portfile is in format #1 if:
# (1) There is only one distfile.
@@ -72,77 +72,77 @@
#
# return yes if the syntax was correct, no if there was a problem.
proc portchecksum::parse_checksums {checksums_str} {
- global checksums_array all_dist_files checksum_types checksum_types_count
+ global checksums_array all_dist_files checksum_types checksum_types_count
- # Parse the string of checksums.
- set nb_checksum [llength $checksums_str]
+ # Parse the string of checksums.
+ set nb_checksum [llength $checksums_str]
- if {[llength $all_dist_files] == 1
- && [expr $nb_checksum % 2] == 0
- && [expr $nb_checksum / 2] <= $checksum_types_count
- && [lsearch -exact $checksum_types [lindex $checksums_str 0]] >= 0} {
- # Convert to format #2
- set checksums_str [linsert $checksums_str 0 $all_dist_files]
- # We increased the size.
- incr nb_checksum
- }
-
- # Create the array with the checksums.
- array set checksums_array {}
-
- set result yes
-
- # Catch out of bounds errors (they're syntax errors).
- if {[catch {
- # Parse the string as if it was in format #2.
- for {set ix_checksum 0} {$ix_checksum < $nb_checksum} {incr ix_checksum} {
- # first word is the file.
- set checksum_filename [lindex $checksums_str $ix_checksum]
-
- # retrieve the list of values we already know for this file.
- set checksum_values {}
- if {[info exists checksums_array($checksum_filename)]} {
- set checksum_values $checksums_array($checksum_filename)
- }
-
- # append the new value
- incr ix_checksum
- while {1} {
- set checksum_type [lindex $checksums_str $ix_checksum]
- if {[lsearch -exact $checksum_types $checksum_type] >= 0} {
- # append the type and the value.
- incr ix_checksum
- set checksum_value [lindex $checksums_str $ix_checksum]
- incr ix_checksum
+ if {[llength $all_dist_files] == 1
+ && [expr $nb_checksum % 2] == 0
+ && [expr $nb_checksum / 2] <= $checksum_types_count
+ && [lsearch -exact $checksum_types [lindex $checksums_str 0]] >= 0} {
+ # Convert to format #2
+ set checksums_str [linsert $checksums_str 0 $all_dist_files]
+ # We increased the size.
+ incr nb_checksum
+ }
- lappend checksum_values $checksum_type
- lappend checksum_values $checksum_value
- } else {
- # this wasn't a type but the next dist file.
- incr ix_checksum -1
- break
- }
+ # Create the array with the checksums.
+ array set checksums_array {}
- # stop if we exhausted all the items in the list.
- if {$ix_checksum == $nb_checksum} {
- break
- }
- }
-
- # set the values in the array.
- set checksums_array($checksum_filename) $checksum_values
- }
- } error]} {
- # An error occurred.
- global errorInfo
- ui_debug "$errorInfo"
- ui_error "Couldn't parse checksum line ($checksums_str) [$error]"
-
- # Something wrong happened.
- set result no
- }
-
- return $result
+ set result yes
+
+ # Catch out of bounds errors (they're syntax errors).
+ if {[catch {
+ # Parse the string as if it was in format #2.
+ for {set ix_checksum 0} {$ix_checksum < $nb_checksum} {incr ix_checksum} {
+ # first word is the file.
+ set checksum_filename [lindex $checksums_str $ix_checksum]
+
+ # retrieve the list of values we already know for this file.
+ set checksum_values {}
+ if {[info exists checksums_array($checksum_filename)]} {
+ set checksum_values $checksums_array($checksum_filename)
+ }
+
+ # append the new value
+ incr ix_checksum
+ while {1} {
+ set checksum_type [lindex $checksums_str $ix_checksum]
+ if {[lsearch -exact $checksum_types $checksum_type] >= 0} {
+ # append the type and the value.
+ incr ix_checksum
+ set checksum_value [lindex $checksums_str $ix_checksum]
+ incr ix_checksum
+
+ lappend checksum_values $checksum_type
+ lappend checksum_values $checksum_value
+ } else {
+ # this wasn't a type but the next dist file.
+ incr ix_checksum -1
+ break
+ }
+
+ # stop if we exhausted all the items in the list.
+ if {$ix_checksum == $nb_checksum} {
+ break
+ }
+ }
+
+ # set the values in the array.
+ set checksums_array($checksum_filename) $checksum_values
+ }
+ } error]} {
+ # An error occurred.
+ global errorInfo
+ ui_debug "$errorInfo"
+ ui_error "Couldn't parse checksum line ($checksums_str) [$error]"
+
+ # Something wrong happened.
+ set result no
+ }
+
+ return $result
}
# calc_md5
@@ -151,7 +151,7 @@
# Return the checksum.
#
proc portchecksum::calc_md5 {file} {
- return [md5 file $file]
+ return [md5 file $file]
}
# calc_sha1
@@ -160,7 +160,7 @@
# Return the checksum.
#
proc portchecksum::calc_sha1 {file} {
- return [sha1 file $file]
+ return [sha1 file $file]
}
# calc_rmd160
@@ -169,7 +169,7 @@
# Return the checksum.
#
proc portchecksum::calc_rmd160 {file} {
- return [rmd160 file $file]
+ return [rmd160 file $file]
}
# checksum_start
@@ -177,9 +177,9 @@
# Target prerun procedure; simply prints a message about what we're doing.
#
proc portchecksum::checksum_start {args} {
- global UI_PREFIX
+ global UI_PREFIX
- ui_msg "$UI_PREFIX [format [msgcat::mc "Verifying checksum(s) for %s"] [option portname]]"
+ ui_msg "$UI_PREFIX [format [msgcat::mc "Verifying checksum(s) for %s"] [option portname]]"
}
# checksum_main
@@ -187,89 +187,89 @@
# Target main procedure. Verifies the checksums of all distfiles.
#
proc portchecksum::checksum_main {args} {
- global UI_PREFIX all_dist_files checksum_types checksums_array portverbose checksum.skip
+ global UI_PREFIX all_dist_files checksum_types checksums_array portverbose checksum.skip
- # If no files have been downloaded, there is nothing to checksum.
- if {![info exists all_dist_files]} {
- return 0
- }
-
- # Completely bypass checksumming if checksum.skip=yes
- # This should be considered an extreme measure
- if {[tbool checksum.skip]} {
- ui_info "$UI_PREFIX Skipping checksum phase"
- return 0
- }
+ # If no files have been downloaded, there is nothing to checksum.
+ if {![info exists all_dist_files]} {
+ return 0
+ }
- # so far, everything went fine.
- set fail no
-
- # Set the list of checksums as the option checksums.
- set checksums_str [option checksums]
-
- # if everything is fine with the syntax, keep on and check the checksum of
- # the distfiles.
- if {[parse_checksums $checksums_str] == "yes"} {
- set distpath [option distpath]
-
- foreach distfile $all_dist_files {
- ui_info "$UI_PREFIX [format [msgcat::mc "Checksumming %s"] $distfile]"
-
- # get the full path of the distfile.
- set fullpath [file join $distpath $distfile]
-
- # check that there is at least one checksum for the distfile.
- if {![info exists checksums_array($distfile)]} {
- ui_error "[format [msgcat::mc "No checksum set for %s"] $distfile]"
- foreach type $checksum_types {
- ui_info "[format [msgcat::mc "Distfile checksum: %s $type %s"] $distfile [calc_$type $fullpath]]"
- }
- set fail yes
- } else {
- # retrieve the list of types/values from the array.
- set portfile_checksums $checksums_array($distfile)
-
- # iterate on this list to check the actual values.
- foreach {type sum} $portfile_checksums {
- set calculated_sum [calc_$type $fullpath]
- if {[string equal $sum $calculated_sum]} {
- ui_debug "[format [msgcat::mc "Correct (%s) checksum for %s"] $type $distfile]"
- } else {
- ui_error "[format [msgcat::mc "Checksum (%s) mismatch for %s"] $type $distfile]"
- ui_info "[format [msgcat::mc "Portfile checksum: %s %s %s"] $distfile $type $sum]"
- ui_info "[format [msgcat::mc "Distfile checksum: %s %s %s"] $distfile $type $calculated_sum]"
-
- # Raise the failure flag
- set fail yes
- }
- }
- }
-
- }
- } else {
- # Something went wrong with the syntax.
- set fail yes
- }
+ # Completely bypass checksumming if checksum.skip=yes
+ # This should be considered an extreme measure
+ if {[tbool checksum.skip]} {
+ ui_info "$UI_PREFIX Skipping checksum phase"
+ return 0
+ }
- if {[tbool fail]} {
-
- # Show the desired checksum line for easy cut-paste
- set sums ""
- foreach distfile $all_dist_files {
- if {[llength $all_dist_files] > 1} {
- lappend sums $distfile
- }
-
- set fullpath [file join $distpath $distfile]
- foreach type $checksum_types {
- lappend sums [format "%-8s%s" $type [calc_$type $fullpath]]
- }
- }
- ui_info "The correct checksum line may be:"
- ui_info [format "%-20s%s" "checksums" [join $sums [format " \\\n%-20s" ""]]]
-
- return -code error "[msgcat::mc "Unable to verify file checksums"]"
- }
+ # so far, everything went fine.
+ set fail no
- return 0
+ # Set the list of checksums as the option checksums.
+ set checksums_str [option checksums]
+
+ # if everything is fine with the syntax, keep on and check the checksum of
+ # the distfiles.
+ if {[parse_checksums $checksums_str] == "yes"} {
+ set distpath [option distpath]
+
+ foreach distfile $all_dist_files {
+ ui_info "$UI_PREFIX [format [msgcat::mc "Checksumming %s"] $distfile]"
+
+ # get the full path of the distfile.
+ set fullpath [file join $distpath $distfile]
+
+ # check that there is at least one checksum for the distfile.
+ if {![info exists checksums_array($distfile)]} {
+ ui_error "[format [msgcat::mc "No checksum set for %s"] $distfile]"
+ foreach type $checksum_types {
+ ui_info "[format [msgcat::mc "Distfile checksum: %s $type %s"] $distfile [calc_$type $fullpath]]"
+ }
+ set fail yes
+ } else {
+ # retrieve the list of types/values from the array.
+ set portfile_checksums $checksums_array($distfile)
+
+ # iterate on this list to check the actual values.
+ foreach {type sum} $portfile_checksums {
+ set calculated_sum [calc_$type $fullpath]
+ if {[string equal $sum $calculated_sum]} {
+ ui_debug "[format [msgcat::mc "Correct (%s) checksum for %s"] $type $distfile]"
+ } else {
+ ui_error "[format [msgcat::mc "Checksum (%s) mismatch for %s"] $type $distfile]"
+ ui_info "[format [msgcat::mc "Portfile checksum: %s %s %s"] $distfile $type $sum]"
+ ui_info "[format [msgcat::mc "Distfile checksum: %s %s %s"] $distfile $type $calculated_sum]"
+
+ # Raise the failure flag
+ set fail yes
+ }
+ }
+ }
+
+ }
+ } else {
+ # Something went wrong with the syntax.
+ set fail yes
+ }
+
+ if {[tbool fail]} {
+
+ # Show the desired checksum line for easy cut-paste
+ set sums ""
+ foreach distfile $all_dist_files {
+ if {[llength $all_dist_files] > 1} {
+ lappend sums $distfile
+ }
+
+ set fullpath [file join $distpath $distfile]
+ foreach type $checksum_types {
+ lappend sums [format "%-8s%s" $type [calc_$type $fullpath]]
+ }
+ }
+ ui_info "The correct checksum line may be:"
+ ui_info [format "%-20s%s" "checksums" [join $sums [format " \\\n%-20s" ""]]]
+
+ return -code error "[msgcat::mc "Unable to verify file checksums"]"
+ }
+
+ return 0
}
Modified: branches/images-and-archives/base/src/port1.0/portclean.tcl
===================================================================
--- branches/images-and-archives/base/src/port1.0/portclean.tcl 2009-05-04 04:15:01 UTC (rev 50562)
+++ branches/images-and-archives/base/src/port1.0/portclean.tcl 2009-05-04 06:22:25 UTC (rev 50563)
@@ -17,7 +17,7 @@
# 3. Neither the name of Apple Computer, Inc. nor the names of its contributors
# may be used to endorse or promote products derived from this software
# without specific prior written permission.
-#
+#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
@@ -51,59 +51,59 @@
proc portclean::clean_start {args} {
global UI_PREFIX
-
+
ui_msg "$UI_PREFIX [format [msgcat::mc "Cleaning %s"] [option portname]]"
}
proc portclean::clean_main {args} {
global UI_PREFIX
- global ports_clean_dist ports_clean_work ports_clean_archive
- global ports_clean_all usealtworkpath
+ global ports_clean_dist ports_clean_work ports_clean_archive
+ global ports_clean_all usealtworkpath
- if {[info exists ports_clean_all] && $ports_clean_all == "yes" || \
- [info exists ports_clean_dist] && $ports_clean_dist == "yes"} {
- ui_info "$UI_PREFIX [format [msgcat::mc "Removing distfiles for %s"] [option portname]]"
- clean_dist
- }
- if {[info exists ports_clean_all] && $ports_clean_all == "yes" || \
- [info exists ports_clean_archive] && $ports_clean_archive == "yes"} {
- ui_info "$UI_PREFIX [format [msgcat::mc "Removing archives for %s"] [option portname]]"
- clean_archive
- }
- if {[info exists ports_clean_all] && $ports_clean_all == "yes" || \
- [info exists ports_clean_work] && $ports_clean_work == "yes" || \
- (!([info exists ports_clean_dist] && $ports_clean_dist == "yes") && \
- !([info exists ports_clean_archive] && $ports_clean_archive == "yes"))} {
- ui_info "$UI_PREFIX [format [msgcat::mc "Removing build directory for %s"] [option portname]]"
- clean_work
- }
+ if {[info exists ports_clean_all] && $ports_clean_all == "yes" || \
+ [info exists ports_clean_dist] && $ports_clean_dist == "yes"} {
+ ui_info "$UI_PREFIX [format [msgcat::mc "Removing distfiles for %s"] [option portname]]"
+ clean_dist
+ }
+ if {[info exists ports_clean_all] && $ports_clean_all == "yes" || \
+ [info exists ports_clean_archive] && $ports_clean_archive == "yes"} {
+ ui_info "$UI_PREFIX [format [msgcat::mc "Removing archives for %s"] [option portname]]"
+ clean_archive
+ }
+ if {[info exists ports_clean_all] && $ports_clean_all == "yes" || \
+ [info exists ports_clean_work] && $ports_clean_work == "yes" || \
+ (!([info exists ports_clean_dist] && $ports_clean_dist == "yes") && \
+ !([info exists ports_clean_archive] && $ports_clean_archive == "yes"))} {
+ ui_info "$UI_PREFIX [format [msgcat::mc "Removing build directory for %s"] [option portname]]"
+ clean_work
+ }
- # start gsoc-08 privileges
- if {[info exists usealtworkpath] && $usealtworkpath == "yes"} {
- ui_info "$UI_PREFIX [format [msgcat::mc "Removing alt source directory for %s"] [option portname]]"
- clean_altsource
- }
- # end gsoc-08 privileges
-
+ # start gsoc-08 privileges
+ if {[info exists usealtworkpath] && $usealtworkpath == "yes"} {
+ ui_info "$UI_PREFIX [format [msgcat::mc "Removing alt source directory for %s"] [option portname]]"
+ clean_altsource
+ }
+ # end gsoc-08 privileges
+
return 0
}
proc portclean::clean_altsource {args} {
global usealtworkpath worksymlink
-
- set sourcepath [string map {"work" ""} $worksymlink]
- if {[file isdirectory $sourcepath]} {
- ui_debug "Removing directory: ${sourcepath}"
- if {[catch {delete $sourcepath} result]} {
- ui_debug "$::errorInfo"
- ui_error "$result"
- }
- } else {
- ui_debug "No alt source directory found to remove."
- }
+ set sourcepath [string map {"work" ""} $worksymlink]
- return 0
+ if {[file isdirectory $sourcepath]} {
+ ui_debug "Removing directory: ${sourcepath}"
+ if {[catch {delete $sourcepath} result]} {
+ ui_debug "$::errorInfo"
+ ui_error "$result"
+ }
+ } else {
+ ui_debug "No alt source directory found to remove."
+ }
+
+ return 0
}
#
@@ -111,142 +111,142 @@
# This is crude, but works.
#
proc portclean::clean_dist {args} {
- global ports_force portname distpath dist_subdir distfiles
+ global ports_force portname distpath dist_subdir distfiles
- # remove known distfiles for sure (if they exist)
- set count 0
- foreach file $distfiles {
- if {[info exist distpath] && [info exists dist_subdir]} {
- set distfile [file join $distpath $dist_subdir $file]
- } else {
- set distfile [file join $distpath $file]
- }
- if {[file isfile $distfile]} {
- ui_debug "Removing file: $distfile"
- if {[catch {delete $distfile} result]} {
- ui_debug "$::errorInfo"
- ui_error "$result"
- }
- set count [expr $count + 1]
- }
- }
- if {$count > 0} {
- ui_debug "$count distfile(s) removed."
- } else {
- ui_debug "No distfiles found to remove at $distpath"
- }
+ # remove known distfiles for sure (if they exist)
+ set count 0
+ foreach file $distfiles {
+ if {[info exist distpath] && [info exists dist_subdir]} {
+ set distfile [file join $distpath $dist_subdir $file]
+ } else {
+ set distfile [file join $distpath $file]
+ }
+ if {[file isfile $distfile]} {
+ ui_debug "Removing file: $distfile"
+ if {[catch {delete $distfile} result]} {
+ ui_debug "$::errorInfo"
+ ui_error "$result"
+ }
+ set count [expr $count + 1]
+ }
+ }
+ if {$count > 0} {
+ ui_debug "$count distfile(s) removed."
+ } else {
+ ui_debug "No distfiles found to remove at $distpath"
+ }
- # next remove dist_subdir if only needed for this port,
- # or if user forces us to
- set dirlist [list]
- if {($dist_subdir != $portname)} {
- if {[info exists dist_subdir]} {
- set distfullpath [file join $distpath $dist_subdir]
- if {!([info exists ports_force] && $ports_force == "yes")
- && [file isdirectory $distfullpath]
- && [llength [readdir $distfullpath]] > 0} {
- ui_warn [format [msgcat::mc "Distfiles directory '%s' may contain distfiles needed for other ports, use the -f flag to force removal" ] [file join $distpath $dist_subdir]]
- } else {
- lappend dirlist $dist_subdir
- lappend dirlist $portname
- }
- } else {
- lappend dirlist $portname
- }
- } else {
- lappend dirlist $portname
- }
- # loop through directories
- set count 0
- foreach dir $dirlist {
- set distdir [file join $distpath $dir]
- if {[file isdirectory $distdir]} {
- ui_debug "Removing directory: ${distdir}"
- if {[catch {delete $distdir} result]} {
- ui_debug "$::errorInfo"
- ui_error "$result"
- }
- set count [expr $count + 1]
- }
- }
- if {$count > 0} {
- ui_debug "$count distfile directory(s) removed."
- } else {
- ui_debug "No distfile directory found to remove."
- }
- return 0
+ # next remove dist_subdir if only needed for this port,
+ # or if user forces us to
+ set dirlist [list]
+ if {($dist_subdir != $portname)} {
+ if {[info exists dist_subdir]} {
+ set distfullpath [file join $distpath $dist_subdir]
+ if {!([info exists ports_force] && $ports_force == "yes")
+ && [file isdirectory $distfullpath]
+ && [llength [readdir $distfullpath]] > 0} {
+ ui_warn [format [msgcat::mc "Distfiles directory '%s' may contain distfiles needed for other ports, use the -f flag to force removal" ] [file join $distpath $dist_subdir]]
+ } else {
+ lappend dirlist $dist_subdir
+ lappend dirlist $portname
+ }
+ } else {
+ lappend dirlist $portname
+ }
+ } else {
+ lappend dirlist $portname
+ }
+ # loop through directories
+ set count 0
+ foreach dir $dirlist {
+ set distdir [file join $distpath $dir]
+ if {[file isdirectory $distdir]} {
+ ui_debug "Removing directory: ${distdir}"
+ if {[catch {delete $distdir} result]} {
+ ui_debug "$::errorInfo"
+ ui_error "$result"
+ }
+ set count [expr $count + 1]
+ }
+ }
+ if {$count > 0} {
+ ui_debug "$count distfile directory(s) removed."
+ } else {
+ ui_debug "No distfile directory found to remove."
+ }
+ return 0
}
proc portclean::clean_work {args} {
global portbuildpath worksymlink
- if {[file isdirectory $portbuildpath]} {
- ui_debug "Removing directory: ${portbuildpath}"
- if {[catch {delete $portbuildpath} result]} {
- ui_debug "$::errorInfo"
- ui_error "$result"
- }
- } else {
- ui_debug "No work directory found to remove at ${portbuildpath}"
- }
+ if {[file isdirectory $portbuildpath]} {
+ ui_debug "Removing directory: ${portbuildpath}"
+ if {[catch {delete $portbuildpath} result]} {
+ ui_debug "$::errorInfo"
+ ui_error "$result"
+ }
+ } else {
+ ui_debug "No work directory found to remove at ${portbuildpath}"
+ }
- # Clean symlink, if necessary
- if {![catch {file type $worksymlink} result] && $result eq "link"} {
- ui_debug "Removing symlink: $worksymlink"
- delete $worksymlink
- }
+ # Clean symlink, if necessary
+ if {![catch {file type $worksymlink} result] && $result eq "link"} {
+ ui_debug "Removing symlink: $worksymlink"
+ delete $worksymlink
+ }
- return 0
+ return 0
}
proc portclean::clean_archive {args} {
- global workpath portarchivepath portname portversion ports_version_glob
+ global workpath portarchivepath portname portversion ports_version_glob
- # Define archive destination directory and target filename
- if {$portarchivepath ne $workpath && $portarchivepath ne ""} {
- set archivepath [file join $portarchivepath [option os.platform] [option os.arch]]
- }
+ # Define archive destination directory and target filename
+ if {$portarchivepath ne $workpath && $portarchivepath ne ""} {
+ set archivepath [file join $portarchivepath [option os.platform] [option os.arch]]
+ }
- if {[info exists ports_version_glob]} {
- # Match all possible archive variatns that match the version
- # glob specified by the user for this OS.
- set fileglob "$portname-[option ports_version_glob]*.[option os.arch].*"
- } else {
- # Match all possible archive variants for the current version on
- # this OS. If you want to delete previous versions, use the
- # version glob argument to clean.
- #
- # We do this because if we don't, then ports that match the
- # first part of the name (e.g. trying to remove foo-*, it will
- # pick up anything foo-bar-* as well, which is undesirable).
- set fileglob "$portname-$portversion*.[option os.arch].*"
- }
+ if {[info exists ports_version_glob]} {
+ # Match all possible archive variatns that match the version
+ # glob specified by the user for this OS.
+ set fileglob "$portname-[option ports_version_glob]*.[option os.arch].*"
+ } else {
+ # Match all possible archive variants for the current version on
+ # this OS. If you want to delete previous versions, use the
+ # version glob argument to clean.
+ #
+ # We do this because if we don't, then ports that match the
+ # first part of the name (e.g. trying to remove foo-*, it will
+ # pick up anything foo-bar-* as well, which is undesirable).
+ set fileglob "$portname-$portversion*.[option os.arch].*"
+ }
- # Remove the archive files
- set count 0
- if {![catch {set archivelist [glob [file join $archivepath $fileglob]]} result]} {
- foreach path $archivelist {
- set file [file tail $path]
- # Make sure file is truly a port archive file, and not
- # and accidental match with some other file that might exist.
- if {[regexp "^$portname-\[-_a-zA-Z0-9\.\]+_\[0-9\]*\[+-_a-zA-Z0-9\]*\[\.\][option os.arch]\[\.\]\[a-z\]+\$" $file]} {
- if {[file isfile $path]} {
- ui_debug "Removing archive: $path"
- if {[catch {delete $path} result]} {
- ui_debug "$::errorInfo"
- ui_error "$result"
- }
- set count [expr $count + 1]
- }
- }
- }
- }
- if {$count > 0} {
- ui_debug "$count archive(s) removed."
- } else {
- ui_debug "No archives found to remove at $archivepath"
- }
+ # Remove the archive files
+ set count 0
+ if {![catch {set archivelist [glob [file join $archivepath $fileglob]]} result]} {
+ foreach path $archivelist {
+ set file [file tail $path]
+ # Make sure file is truly a port archive file, and not
+ # and accidental match with some other file that might exist.
+ if {[regexp "^$portname-\[-_a-zA-Z0-9\.\]+_\[0-9\]*\[+-_a-zA-Z0-9\]*\[\.\][option os.arch]\[\.\]\[a-z\]+\$" $file]} {
+ if {[file isfile $path]} {
+ ui_debug "Removing archive: $path"
+ if {[catch {delete $path} result]} {
+ ui_debug "$::errorInfo"
+ ui_error "$result"
+ }
+ set count [expr $count + 1]
+ }
+ }
+ }
+ }
+ if {$count > 0} {
+ ui_debug "$count archive(s) removed."
+ } else {
+ ui_debug "No archives found to remove at $archivepath"
+ }
- return 0
+ return 0
}
Modified: branches/images-and-archives/base/src/port1.0/portconfigure.tcl
===================================================================
--- branches/images-and-archives/base/src/port1.0/portconfigure.tcl 2009-05-04 04:15:01 UTC (rev 50562)
+++ branches/images-and-archives/base/src/port1.0/portconfigure.tcl 2009-05-04 06:22:25 UTC (rev 50563)
@@ -181,6 +181,7 @@
gcc-4.0 { set name "Mac OS X gcc 4.0" }
gcc-4.2 { set name "Mac OS X gcc 4.2" }
llvm-gcc-4.2 { set name "Mac OS X llvm-gcc 4.2" }
+ clang { set name "Mac OS X clang" }
apple-gcc-3.3 { set name "MacPorts Apple gcc 3.3" }
apple-gcc-4.0 { set name "MacPorts Apple gcc 4.0" }
apple-gcc-4.2 { set name "MacPorts Apple gcc 4.2" }
@@ -191,7 +192,6 @@
macports-gcc-4.2 { set name "MacPorts gcc 4.2" }
macports-gcc-4.3 { set name "MacPorts gcc 4.3" }
macports-gcc-4.4 { set name "MacPorts gcc 4.4" }
- ccc { set name "clang ccc" }
default { return -code error "Invalid value for configure.compiler" }
}
ui_debug "Using compiler '$name'"
@@ -342,6 +342,12 @@
cpp { set ret /Developer/usr/llvm-gcc-4.2/bin/llvm-cpp-4.2 }
}
}
+ clang {
+ switch -exact ${type} {
+ cc { set ret /usr/bin/clang }
+ objc { set ret /usr/bin/clang }
+ }
+ }
apple-gcc-3.3 {
switch -exact ${type} {
cc { set ret ${prefix}/bin/gcc-apple-3.3 }
@@ -431,12 +437,6 @@
f90 { set ret ${prefix}/bin/gfortran-mp-4.4 }
}
}
- ccc {
- switch -exact ${type} {
- cc { set ret /Developer/usr/bin/ccc }
- objc { set ret /Developer/usr/bin/ccc }
- }
- }
}
return $ret
}
Modified: branches/images-and-archives/base/src/port1.0/portdepends.tcl
===================================================================
--- branches/images-and-archives/base/src/port1.0/portdepends.tcl 2009-05-04 04:15:01 UTC (rev 50562)
+++ branches/images-and-archives/base/src/port1.0/portdepends.tcl 2009-05-04 06:22:25 UTC (rev 50563)
@@ -16,7 +16,7 @@
# 3. Neither the name of Apple Computer, Inc. nor the names of its contributors
# may be used to endorse or promote products derived from this software
# without specific prior written permission.
-#
+#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
@@ -53,16 +53,16 @@
proc portdepends::validate_depends_options {option action {value ""}} {
global targets
switch $action {
- set {
- foreach depspec $value {
- # port syntax accepts colon-separated junk that we do not understand yet.
- switch -regex $depspec {
- ^(lib|bin|path):([-A-Za-z0-9_/.${}^?+()|\\\\]+):([-._A-Za-z0-9]+)$ {}
- ^(port)(:.+)?:([-._A-Za-z0-9]+)$ {}
- default { return -code error [format [msgcat::mc "invalid depspec: %s"] $depspec] }
- }
- }
- }
+ set {
+ foreach depspec $value {
+ # port syntax accepts colon-separated junk that we do not understand yet.
+ switch -regex $depspec {
+ ^(lib|bin|path):([-A-Za-z0-9_/.${}^?+()|\\\\]+):([-._A-Za-z0-9]+)$ {}
+ ^(port)(:.+)?:([-._A-Za-z0-9]+)$ {}
+ default { return -code error [format [msgcat::mc "invalid depspec: %s"] $depspec] }
+ }
+ }
+ }
}
}
Modified: branches/images-and-archives/base/src/port1.0/portdestroot.tcl
===================================================================
--- branches/images-and-archives/base/src/port1.0/portdestroot.tcl 2009-05-04 04:15:01 UTC (rev 50562)
+++ branches/images-and-archives/base/src/port1.0/portdestroot.tcl 2009-05-04 06:22:25 UTC (rev 50563)
@@ -17,7 +17,7 @@
# 3. Neither the name of Apple Computer, Inc. nor the names of its contributors
# may be used to endorse or promote products derived from this software
# without specific prior written permission.
-#
+#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
@@ -91,43 +91,43 @@
global destroot.umask destroot.asroot macportsuser euid egid usealtworkpath altprefix
global applications_dir frameworks_dir
variable oldmask
-
+
ui_msg "$UI_PREFIX [format [msgcat::mc "Staging %s into destroot"] ${portname}]"
- # start gsoc08-privileges
- if { [getuid] == 0 && [geteuid] == [name_to_uid "$macportsuser"] } {
- # if started with sudo but have dropped the privileges
- ui_debug "Can't run destroot under sudo without elevated privileges (due to mtree)."
- ui_debug "Run destroot without sudo to avoid root privileges."
- ui_debug "Going to escalate privileges back to root."
- setegid $egid
- seteuid $euid
- ui_debug "euid changed to: [geteuid]. egid changed to: [getegid]."
- }
-
- if { [tbool destroot.asroot] && [getuid] != 0 } {
- global errorisprivileges
- set errorisprivileges yes
- return -code error "You can not run this port without elevated privileges. You need to re-run with 'sudo port'.";
- }
-
- if {[info exists usealtworkpath] && $usealtworkpath == "yes"} {
- # rewrite destroot.args
- set argprefix "=[option prefix]"
- set newargprefix "=${altprefix}[option prefix]"
- set newdestrootargs [string map [list $argprefix $newargprefix] [option destroot.args]]
- option destroot.args $newdestrootargs
- }
-
- # end gsoc08-privileges
+ # start gsoc08-privileges
+ if { [getuid] == 0 && [geteuid] == [name_to_uid "$macportsuser"] } {
+ # if started with sudo but have dropped the privileges
+ ui_debug "Can't run destroot under sudo without elevated privileges (due to mtree)."
+ ui_debug "Run destroot without sudo to avoid root privileges."
+ ui_debug "Going to escalate privileges back to root."
+ setegid $egid
+ seteuid $euid
+ ui_debug "euid changed to: [geteuid]. egid changed to: [getegid]."
+ }
+ if { [tbool destroot.asroot] && [getuid] != 0 } {
+ global errorisprivileges
+ set errorisprivileges yes
+ return -code error "You can not run this port without elevated privileges. You need to re-run with 'sudo port'.";
+ }
+
+ if {[info exists usealtworkpath] && $usealtworkpath == "yes"} {
+ # rewrite destroot.args
+ set argprefix "=[option prefix]"
+ set newargprefix "=${altprefix}[option prefix]"
+ set newdestrootargs [string map [list $argprefix $newargprefix] [option destroot.args]]
+ option destroot.args $newdestrootargs
+ }
+
+ # end gsoc08-privileges
+
set oldmask [umask ${destroot.umask}]
set mtree ${portutil::autoconf::mtree_path}
-
+
if { ${destroot.clean} == "yes" } {
delete "${destroot}"
}
-
+
file mkdir "${destroot}"
if { ${os.platform} == "darwin" } {
system "cd \"${destroot}\" && ${mtree} -e -U -f [file join ${portsharepath} install macosx.mtree]"
@@ -330,10 +330,10 @@
# Restore umask
umask $oldmask
-
+
# start gsoc08-privileges
- chownAsRoot $destroot
- # end gsoc08-privileges
+ chownAsRoot $destroot
+ # end gsoc08-privileges
return 0
}
Modified: branches/images-and-archives/base/src/port1.0/portdistcheck.tcl
===================================================================
--- branches/images-and-archives/base/src/port1.0/portdistcheck.tcl 2009-05-04 04:15:01 UTC (rev 50562)
+++ branches/images-and-archives/base/src/port1.0/portdistcheck.tcl 2009-05-04 06:22:25 UTC (rev 50563)
@@ -18,7 +18,7 @@
# 3. Neither the name of Apple Computer, Inc. nor the names of its
# contributors may be used to endorse or promote products derived from
# this software without specific prior written permission.
-#
+#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
@@ -52,87 +52,87 @@
default distcheck.check moddate
proc portdistcheck::distcheck_main {args} {
- global distcheck.check
- global fetch.type
- global portname portpath
-
- set port_moddate [file mtime ${portpath}/Portfile]
+ global distcheck.check
+ global fetch.type
+ global portname portpath
- ui_debug "Portfile modification date is [clock format $port_moddate]"
+ set port_moddate [file mtime ${portpath}/Portfile]
- # Check the distfiles if it's a regular fetch phase.
- if {"${distcheck.check}" != "none"
- && "${fetch.type}" == "standard"} {
- # portfetch 1.0::checkfiles sets fetch_urls list.
- global fetch_urls
- checkfiles
- set totalsize 0
-
- # Check all the files.
- foreach {url_var distfile} $fetch_urls {
- global portfetch::$url_var
- if {![info exists $url_var]} {
- ui_error [format [msgcat::mc "No defined site for tag: %s, using master_sites"] $url_var]
- set url_var master_sites
- global portfetch::$url_var
- }
- if {${distcheck.check} == "moddate"} {
- set count 0
- foreach site [set $url_var] {
- ui_debug [format [msgcat::mc "Checking %s from %s"] $distfile $site]
- set file_url [portfetch::assemble_url $site $distfile]
- if {[catch {set urlnewer [curl isnewer $file_url $port_moddate]} error]} {
- ui_warn "couldn't fetch $file_url for $portname ($error)"
- } else {
- if {$urlnewer} {
- ui_warn "port $portname: $file_url is newer than portfile"
- }
- incr count
- }
- }
- if {$count == 0} {
- ui_error "no mirror had $distfile for $portname"
- }
- } elseif {${distcheck.check} == "filesize"} {
- set count 0
- foreach site [set $url_var] {
- ui_debug [format [msgcat::mc "Checking %s from %s"] $distfile $site]
- set file_url [portfetch::assemble_url $site $distfile]
- if {[catch {set urlsize [curl getsize $file_url]} error]} {
- ui_warn "couldn't fetch $file_url for $portname ($error)"
- } else {
- incr count
- if {$urlsize > 0} {
- ui_info "port $portname: $distfile $urlsize bytes"
- incr totalsize $urlsize
- break
- }
- }
- }
- if {$count == 0} {
- ui_error "no mirror had $distfile for $portname"
- }
- } else {
- ui_error "unknown distcheck.check ${distcheck.check}"
- break
- }
- }
-
- if {${distcheck.check} == "filesize" && $totalsize > 0} {
- if {$totalsize < 1024} {
- set size $totalsize
- set humansize "${size}"
- } elseif {$totalsize < 1024*1024} {
- set size [expr $totalsize / 1024.0]
- set humansize [format "%.1fK" $size]
- } elseif {$totalsize < 1024*1024*1024} {
- set size [expr $totalsize / (1024.0*1024.0)]
- set humansize [format "%.1fM" $size]
- } else {
- set size [expr $totalsize / (1024.0*1024.0*1024.0)]
- set humansize [format "%.1fG" $size]
- }
- ui_msg "$portname: $humansize"
- }
- }
+ ui_debug "Portfile modification date is [clock format $port_moddate]"
+
+ # Check the distfiles if it's a regular fetch phase.
+ if {"${distcheck.check}" != "none"
+ && "${fetch.type}" == "standard"} {
+ # portfetch 1.0::checkfiles sets fetch_urls list.
+ global fetch_urls
+ checkfiles
+ set totalsize 0
+
+ # Check all the files.
+ foreach {url_var distfile} $fetch_urls {
+ global portfetch::$url_var
+ if {![info exists $url_var]} {
+ ui_error [format [msgcat::mc "No defined site for tag: %s, using master_sites"] $url_var]
+ set url_var master_sites
+ global portfetch::$url_var
+ }
+ if {${distcheck.check} == "moddate"} {
+ set count 0
+ foreach site [set $url_var] {
+ ui_debug [format [msgcat::mc "Checking %s from %s"] $distfile $site]
+ set file_url [portfetch::assemble_url $site $distfile]
+ if {[catch {set urlnewer [curl isnewer $file_url $port_moddate]} error]} {
+ ui_warn "couldn't fetch $file_url for $portname ($error)"
+ } else {
+ if {$urlnewer} {
+ ui_warn "port $portname: $file_url is newer than portfile"
+ }
+ incr count
+ }
+ }
+ if {$count == 0} {
+ ui_error "no mirror had $distfile for $portname"
+ }
+ } elseif {${distcheck.check} == "filesize"} {
+ set count 0
+ foreach site [set $url_var] {
+ ui_debug [format [msgcat::mc "Checking %s from %s"] $distfile $site]
+ set file_url [portfetch::assemble_url $site $distfile]
+ if {[catch {set urlsize [curl getsize $file_url]} error]} {
+ ui_warn "couldn't fetch $file_url for $portname ($error)"
+ } else {
+ incr count
+ if {$urlsize > 0} {
+ ui_info "port $portname: $distfile $urlsize bytes"
+ incr totalsize $urlsize
+ break
+ }
+ }
+ }
+ if {$count == 0} {
+ ui_error "no mirror had $distfile for $portname"
+ }
+ } else {
+ ui_error "unknown distcheck.check ${distcheck.check}"
+ break
+ }
+ }
+
+ if {${distcheck.check} == "filesize" && $totalsize > 0} {
+ if {$totalsize < 1024} {
+ set size $totalsize
+ set humansize "${size}"
+ } elseif {$totalsize < 1024*1024} {
+ set size [expr $totalsize / 1024.0]
+ set humansize [format "%.1fK" $size]
+ } elseif {$totalsize < 1024*1024*1024} {
+ set size [expr $totalsize / (1024.0*1024.0)]
+ set humansize [format "%.1fM" $size]
+ } else {
+ set size [expr $totalsize / (1024.0*1024.0*1024.0)]
+ set humansize [format "%.1fG" $size]
+ }
+ ui_msg "$portname: $humansize"
+ }
+ }
}
Modified: branches/images-and-archives/base/src/port1.0/portextract.tcl
===================================================================
--- branches/images-and-archives/base/src/port1.0/portextract.tcl 2009-05-04 04:15:01 UTC (rev 50562)
+++ branches/images-and-archives/base/src/port1.0/portextract.tcl 2009-05-04 06:22:25 UTC (rev 50563)
@@ -131,11 +131,11 @@
if {[catch {command_exec extract} result]} {
return -code error "$result"
}
-
- # start gsoc08-privileges
- chownAsRoot ${extract.dir}
- # end gsoc08-privileges
-
+
+ # start gsoc08-privileges
+ chownAsRoot ${extract.dir}
+ # end gsoc08-privileges
+
}
return 0
}
Modified: branches/images-and-archives/base/src/port1.0/portfetch.tcl
===================================================================
--- branches/images-and-archives/base/src/port1.0/portfetch.tcl 2009-05-04 04:15:01 UTC (rev 50562)
+++ branches/images-and-archives/base/src/port1.0/portfetch.tcl 2009-05-04 06:22:25 UTC (rev 50563)
@@ -16,7 +16,7 @@
# 3. Neither the name of Apple Computer, Inc. nor the names of its contributors
# may be used to endorse or promote products derived from this software
# without specific prior written permission.
-#
+#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
@@ -54,12 +54,12 @@
# define options: distname master_sites
options master_sites patch_sites extract.suffix distfiles patchfiles use_zip use_bzip2 use_lzma use_7z use_dmg dist_subdir \
- fetch.type fetch.user fetch.password fetch.use_epsv fetch.ignore_sslcert \
- master_sites.mirror_subdir patch_sites.mirror_subdir portname \
- cvs.module cvs.root cvs.password cvs.date cvs.tag cvs.method \
- svn.url svn.tag svn.revision svn.method \
- git.url git.branch \
- hg.url hg.tag
+ fetch.type fetch.user fetch.password fetch.use_epsv fetch.ignore_sslcert \
+ master_sites.mirror_subdir patch_sites.mirror_subdir portname \
+ cvs.module cvs.root cvs.password cvs.date cvs.tag cvs.method \
+ svn.url svn.tag svn.revision svn.method \
+ git.url git.branch \
+ hg.url hg.tag
# XXX we use the command framework to buy us some useful features,
# but this is not a user-modifiable command
@@ -182,12 +182,12 @@
proc portfetch::suffix {distname} {
global extract.suffix fetch.type
switch -- "${fetch.type}" {
- cvs -
- svn -
- git -
- hg { return "" }
- standard -
- default { return "${distname}${extract.suffix}" }
+ cvs -
+ svn -
+ git -
+ hg { return "" }
+ standard -
+ default { return "${distname}${extract.suffix}" }
}
}
# XXX import suffix into the global namespace as it is currently used from
@@ -221,15 +221,15 @@
}
return {}
}
-
+
set ret [list]
foreach element $portfetch::mirror_sites::sites($mirrors) {
-
- # here we have the chance to take a look at tags, that possibly
- # have been assigned in mirror_sites.tcl
- set splitlist [split $element :]
- # every element is a URL, so we'll always have multiple elements. no need to check
- set element "[lindex $splitlist 0]:[lindex $splitlist 1]"
+
+ # here we have the chance to take a look at tags, that possibly
+ # have been assigned in mirror_sites.tcl
+ set splitlist [split $element :]
+ # every element is a URL, so we'll always have multiple elements. no need to check
+ set element "[lindex $splitlist 0]:[lindex $splitlist 1]"
set mirror_tag "[lindex $splitlist 2]"
set name_re {\$(?:name\y|\{name\})}
@@ -238,28 +238,28 @@
if {[regexp $name_re $element]} {
set mirror_tag ""
}
-
- if {$mirror_tag == "mirror"} {
- set thesubdir ${dist_subdir}
- } elseif {$subdir == "" && $mirror_tag != "nosubdir"} {
- set thesubdir ${portname}
- } else {
- set thesubdir ${subdir}
- }
-
- # parse an embedded $name. if present, remove the subdir
- if {[regsub $name_re $element $thesubdir element] > 0} {
- set thesubdir ""
- }
-
- if {"$tag" != ""} {
- eval append element "${thesubdir}:${tag}"
- } else {
- eval append element "${thesubdir}"
- }
+
+ if {$mirror_tag == "mirror"} {
+ set thesubdir ${dist_subdir}
+ } elseif {$subdir == "" && $mirror_tag != "nosubdir"} {
+ set thesubdir ${portname}
+ } else {
+ set thesubdir ${subdir}
+ }
+
+ # parse an embedded $name. if present, remove the subdir
+ if {[regsub $name_re $element $thesubdir element] > 0} {
+ set thesubdir ""
+ }
+
+ if {"$tag" != ""} {
+ eval append element "${thesubdir}:${tag}"
+ } else {
+ eval append element "${thesubdir}"
+ }
eval lappend ret $element
}
-
+
return $ret
}
@@ -271,15 +271,15 @@
proc portfetch::checksites {args} {
global patch_sites master_sites master_sites.mirror_subdir \
patch_sites.mirror_subdir fallback_mirror_site global_mirror_site env
-
+
append master_sites " ${global_mirror_site} ${fallback_mirror_site}"
if {[info exists env(MASTER_SITE_LOCAL)]} {
- set master_sites [concat $env(MASTER_SITE_LOCAL) $master_sites]
+ set master_sites [concat $env(MASTER_SITE_LOCAL) $master_sites]
}
-
+
append patch_sites " ${global_mirror_site} ${fallback_mirror_site}"
if {[info exists env(PATCH_SITE_LOCAL)]} {
- set patch_sites [concat $env(PATCH_SITE_LOCAL) $patch_sites]
+ set patch_sites [concat $env(PATCH_SITE_LOCAL) $patch_sites]
}
foreach list {master_sites patch_sites} {
@@ -287,26 +287,26 @@
if {![info exists uplist]} {
continue
}
-
+
set site_list [list]
foreach site $uplist {
if {[regexp {([a-zA-Z]+://.+)} $site match site]} {
set site_list [concat $site_list $site]
} else {
- set splitlist [split $site :]
- if {[llength $splitlist] > 3 || [llength $splitlist] <1} {
+ set splitlist [split $site :]
+ if {[llength $splitlist] > 3 || [llength $splitlist] <1} {
ui_error [format [msgcat::mc "Unable to process mirror sites for: %s, ignoring."] $site]
- }
- set mirrors "[lindex $splitlist 0]"
- set subdir "[lindex $splitlist 1]"
- set tag "[lindex $splitlist 2]"
+ }
+ set mirrors "[lindex $splitlist 0]"
+ set subdir "[lindex $splitlist 1]"
+ set tag "[lindex $splitlist 2]"
if {[info exists $list.mirror_subdir]} {
append subdir "[set ${list}.mirror_subdir]"
}
set site_list [concat $site_list [mirror_sites $mirrors $tag $subdir]]
}
}
-
+
# add in the global and fallback mirrors for each tag
foreach site $site_list {
if {[regexp {([a-zA-Z]+://.+/?):([0-9A-Za-z_-]+)$} $site match site tag]} {
@@ -321,9 +321,9 @@
}
}
}
-
+
foreach site $site_list {
- if {[regexp {([a-zA-Z]+://.+/?):([0-9A-Za-z_-]+)$} $site match site tag]} {
+ if {[regexp {([a-zA-Z]+://.+/?):([0-9A-Za-z_-]+)$} $site match site tag]} {
lappend portfetch::$tag $site
} else {
lappend portfetch::$list $site
@@ -336,44 +336,44 @@
proc portfetch::checkpatchfiles {args} {
global patchfiles all_dist_files patch_sites filespath
variable fetch_urls
-
+
if {[info exists patchfiles]} {
- foreach file $patchfiles {
- if {![file exists $filespath/$file]} {
- set distsite [getdisttag $file]
- set file [getdistname $file]
- lappend all_dist_files $file
- if {$distsite != ""} {
- lappend fetch_urls $distsite $file
- } elseif {[info exists patch_sites]} {
- lappend fetch_urls patch_sites $file
- } else {
- lappend fetch_urls master_sites $file
- }
- }
- }
+ foreach file $patchfiles {
+ if {![file exists $filespath/$file]} {
+ set distsite [getdisttag $file]
+ set file [getdistname $file]
+ lappend all_dist_files $file
+ if {$distsite != ""} {
+ lappend fetch_urls $distsite $file
+ } elseif {[info exists patch_sites]} {
+ lappend fetch_urls patch_sites $file
+ } else {
+ lappend fetch_urls master_sites $file
+ }
+ }
}
+ }
}
# Checks dist files and their tags to assemble url lists for later fetching
proc portfetch::checkdistfiles {args} {
global distfiles all_dist_files master_sites filespath
variable fetch_urls
-
+
if {[info exists distfiles]} {
foreach file $distfiles {
- if {![file exists $filespath/$file]} {
- set distsite [getdisttag $file]
- set file [getdistname $file]
- lappend all_dist_files $file
- if {$distsite != ""} {
- lappend fetch_urls $distsite $file
- } else {
- lappend fetch_urls master_sites $file
- }
- }
+ if {![file exists $filespath/$file]} {
+ set distsite [getdisttag $file]
+ set file [getdistname $file]
+ lappend all_dist_files $file
+ if {$distsite != ""} {
+ lappend fetch_urls $distsite $file
+ } else {
+ lappend fetch_urls master_sites $file
+ }
}
}
+ }
}
# sorts fetch_urls in order of ping time
@@ -435,7 +435,7 @@
}
ui_debug "$host ping time is $pingtimes($host)"
}
-
+
set pinglist {}
foreach site $urllist {
regexp $hostregex $site -> host
@@ -454,56 +454,56 @@
# Perform the full checksites/checkpatchfiles/checkdistfiles sequence.
# This method is used by distcheck target.
proc portfetch::checkfiles {args} {
- variable fetch_urls
+ variable fetch_urls
- checksites
- checkpatchfiles
- checkdistfiles
+ checksites
+ checkpatchfiles
+ checkdistfiles
}
# Perform a CVS login and fetch, storing the CVS login
# information in a custom .cvspass file
proc portfetch::cvsfetch {args} {
- global workpath cvs.env cvs.cmd cvs.args cvs.post_args
+ global workpath cvs.env cvs.cmd cvs.args cvs.post_args
global cvs.root cvs.date cvs.tag cvs.method cvs.password
global patch_sites patchfiles filespath
set cvs.args "${cvs.method} ${cvs.args}"
if {${cvs.method} == "export" && ![string length ${cvs.tag}] && ![string length ${cvs.date}]} {
- set cvs.tag "HEAD"
+ set cvs.tag "HEAD"
}
if {[string length ${cvs.tag}]} {
- set cvs.args "${cvs.args} -r ${cvs.tag}"
+ set cvs.args "${cvs.args} -r ${cvs.tag}"
}
if {[string length ${cvs.date}]} {
- set cvs.args "${cvs.args} -D ${cvs.date}"
+ set cvs.args "${cvs.args} -D ${cvs.date}"
}
if {[regexp ^:pserver: ${cvs.root}]} {
- set savecmd ${cvs.cmd}
- set saveargs ${cvs.args}
- set savepost_args ${cvs.post_args}
- set cvs.cmd "echo ${cvs.password} | $portutil::autoconf::cvs_path"
- set cvs.args login
- set cvs.post_args ""
- if {[catch {command_exec cvs -notty "" "2>&1"} result]} {
- return -code error [msgcat::mc "CVS login failed"]
- }
- set cvs.cmd ${savecmd}
- set cvs.args ${saveargs}
- set cvs.post_args ${savepost_args}
+ set savecmd ${cvs.cmd}
+ set saveargs ${cvs.args}
+ set savepost_args ${cvs.post_args}
+ set cvs.cmd "echo ${cvs.password} | $portutil::autoconf::cvs_path"
+ set cvs.args login
+ set cvs.post_args ""
+ if {[catch {command_exec cvs -notty "" "2>&1"} result]} {
+ return -code error [msgcat::mc "CVS login failed"]
+ }
+ set cvs.cmd ${savecmd}
+ set cvs.args ${saveargs}
+ set cvs.post_args ${savepost_args}
} else {
- set env(CVS_RSH) ssh
+ set env(CVS_RSH) ssh
}
if {[catch {command_exec cvs "" "2>&1"} result]} {
- return -code error [msgcat::mc "CVS check out failed"]
+ return -code error [msgcat::mc "CVS check out failed"]
}
if {[info exists patchfiles]} {
- return [portfetch::fetchfiles]
+ return [portfetch::fetchfiles]
}
return 0
}
@@ -512,33 +512,33 @@
proc portfetch::svnfetch {args} {
global workpath prefix_frozen
global svn.env svn.cmd svn.args svn.post_args svn.revision svn.url svn.method
-
+
# Look for the svn command, either in the path or in the prefix
set goodcmd 0
foreach svncmd "${svn.cmd} ${prefix_frozen}/bin/svn svn" {
- if { [file executable ${svncmd}] } {
- set svn.cmd $svncmd
- set goodcmd 1
- break;
- }
+ if { [file executable ${svncmd}] } {
+ set svn.cmd $svncmd
+ set goodcmd 1
+ break;
+ }
}
if { !$goodcmd } {
- ui_error "The subversion tool (svn) is required to fetch ${svn.url}."
- ui_error "Please install the subversion port before proceeding."
- return -code error [msgcat::mc "Subversion check out failed"]
+ ui_error "The subversion tool (svn) is required to fetch ${svn.url}."
+ ui_error "Please install the subversion port before proceeding."
+ return -code error [msgcat::mc "Subversion check out failed"]
}
-
+
set svn.args "${svn.method} ${svn.args}"
if {[string length ${svn.revision}]} {
- set svn.args "${svn.args} -r ${svn.revision}"
+ set svn.args "${svn.args} -r ${svn.revision}"
}
if {[catch {command_exec svn "" "2>&1"} result]} {
- return -code error [msgcat::mc "Subversion check out failed"]
+ return -code error [msgcat::mc "Subversion check out failed"]
}
if {[info exists patchfiles]} {
- return [portfetch::fetchfiles]
+ return [portfetch::fetchfiles]
}
return 0
@@ -548,7 +548,7 @@
proc portfetch::gitfetch {args} {
global worksrcpath prefix_frozen
global git.url git.branch git.sha1
-
+
# Look for the git command
set git.cmd {}
foreach gitcmd "$portutil::autoconf::git_path $prefix_frozen/bin/git git" {
@@ -562,7 +562,7 @@
ui_error "Please install the git-core port before proceeding."
return -code error [msgcat::mc "Git command not found"]
}
-
+
set options "-q"
if {[string length ${git.branch}] == 0} {
# if we're just using HEAD, we can make a shallow repo
@@ -573,7 +573,7 @@
if {[catch {system $cmdstring} result]} {
return -code error [msgcat::mc "Git clone failed"]
}
-
+
if {[string length ${git.branch}] > 0} {
set env "GIT_DIR=${worksrcpath}/.git GIT_WORK_TREE=${worksrcpath}"
set cmdstring "$env ${git.cmd} checkout -q ${git.branch} 2>&1"
@@ -582,11 +582,11 @@
return -code error [msgcat::mc "Git checkout failed"]
}
}
-
+
if {[info exists patchfiles]} {
return [portfetch::fetchfiles]
}
-
+
return 0
}
@@ -625,120 +625,120 @@
# Perform a standard fetch, assembling fetch urls from
# the listed url variable and associated distfile
proc portfetch::fetchfiles {args} {
- global distpath all_dist_files UI_PREFIX
- global fetch.user fetch.password fetch.use_epsv fetch.ignore_sslcert fetch.remote_time
- global distfile site
- global portverbose
+ global distpath all_dist_files UI_PREFIX
+ global fetch.user fetch.password fetch.use_epsv fetch.ignore_sslcert fetch.remote_time
+ global distfile site
+ global portverbose
variable fetch_urls
- if {![file isdirectory $distpath]} {
- if {[catch {file mkdir $distpath} result]} {
- return -code error [format [msgcat::mc "Unable to create distribution files path: %s"] $result]
- }
- }
-
- set fetch_options {}
- if {[string length ${fetch.user}] || [string length ${fetch.password}]} {
- lappend fetch_options -u
- lappend fetch_options "${fetch.user}:${fetch.password}"
- }
- if {${fetch.use_epsv} != "yes"} {
- lappend fetch_options "--disable-epsv"
- }
- if {${fetch.ignore_sslcert} != "no"} {
- lappend fetch_options "--ignore-ssl-cert"
- }
- if {${fetch.remote_time} != "no"} {
- lappend fetch_options "--remote-time"
- }
- if {$portverbose == "yes"} {
- lappend fetch_options "-v"
- }
- set sorted no
-
- foreach {url_var distfile} $fetch_urls {
- if {![file isfile $distpath/$distfile]} {
- ui_info "$UI_PREFIX [format [msgcat::mc "%s doesn't seem to exist in %s"] $distfile $distpath]"
- if {![file writable $distpath]} {
- return -code error [format [msgcat::mc "%s must be writable"] $distpath]
- }
- if {!$sorted} {
- sortsites
- set sorted yes
- }
- variable portfetch::$url_var
- if {![info exists $url_var]} {
- ui_error [format [msgcat::mc "No defined site for tag: %s, using master_sites"] $url_var]
- set url_var master_sites
- variable portfetch::$url_var
- }
- unset -nocomplain fetched
- foreach site [set $url_var] {
- ui_msg "$UI_PREFIX [format [msgcat::mc "Attempting to fetch %s from %s"] $distfile $site]"
- set file_url [portfetch::assemble_url $site $distfile]
- set effectiveURL ""
- if {![catch {eval curl fetch --effective-url effectiveURL $fetch_options {$file_url} ${distpath}/${distfile}.TMP} result] &&
- ![catch {file rename -force "${distpath}/${distfile}.TMP" "${distpath}/${distfile}"} result]} {
+ if {![file isdirectory $distpath]} {
+ if {[catch {file mkdir $distpath} result]} {
+ return -code error [format [msgcat::mc "Unable to create distribution files path: %s"] $result]
+ }
+ }
- # Special hack to check for sourceforge mirrors, which don't return a proper error code on failure
- if {![string equal $effectiveURL $file_url] &&
- [string match "*sourceforge*" $file_url] &&
- [string match "*failedmirror*" $effectiveURL]} {
-
- # *SourceForge hackage in effect*
- # The url seen by curl seems to have been a redirect to the sourceforge mirror page
- ui_debug "[msgcat::mc "Fetching from sourceforge mirror failed"]"
- file delete -force "${distpath}/${distfile}.TMP"
-
- # Continue on to try the next mirror, if any
- } else {
-
- # Successful fetch
- set fetched 1
- break
-
- }
+ set fetch_options {}
+ if {[string length ${fetch.user}] || [string length ${fetch.password}]} {
+ lappend fetch_options -u
+ lappend fetch_options "${fetch.user}:${fetch.password}"
+ }
+ if {${fetch.use_epsv} != "yes"} {
+ lappend fetch_options "--disable-epsv"
+ }
+ if {${fetch.ignore_sslcert} != "no"} {
+ lappend fetch_options "--ignore-ssl-cert"
+ }
+ if {${fetch.remote_time} != "no"} {
+ lappend fetch_options "--remote-time"
+ }
+ if {$portverbose == "yes"} {
+ lappend fetch_options "-v"
+ }
+ set sorted no
- } else {
- ui_debug "[msgcat::mc "Fetching failed:"]: $result"
- file delete -force "${distpath}/${distfile}.TMP"
- }
- }
- if {![info exists fetched]} {
- return -code error [msgcat::mc "fetch failed"]
- }
- }
- }
+ foreach {url_var distfile} $fetch_urls {
+ if {![file isfile $distpath/$distfile]} {
+ ui_info "$UI_PREFIX [format [msgcat::mc "%s doesn't seem to exist in %s"] $distfile $distpath]"
+ if {![file writable $distpath]} {
+ return -code error [format [msgcat::mc "%s must be writable"] $distpath]
+ }
+ if {!$sorted} {
+ sortsites
+ set sorted yes
+ }
+ variable portfetch::$url_var
+ if {![info exists $url_var]} {
+ ui_error [format [msgcat::mc "No defined site for tag: %s, using master_sites"] $url_var]
+ set url_var master_sites
+ variable portfetch::$url_var
+ }
+ unset -nocomplain fetched
+ foreach site [set $url_var] {
+ ui_msg "$UI_PREFIX [format [msgcat::mc "Attempting to fetch %s from %s"] $distfile $site]"
+ set file_url [portfetch::assemble_url $site $distfile]
+ set effectiveURL ""
+ if {![catch {eval curl fetch --effective-url effectiveURL $fetch_options {$file_url} ${distpath}/${distfile}.TMP} result] &&
+ ![catch {file rename -force "${distpath}/${distfile}.TMP" "${distpath}/${distfile}"} result]} {
+
+ # Special hack to check for sourceforge mirrors, which don't return a proper error code on failure
+ if {![string equal $effectiveURL $file_url] &&
+ [string match "*sourceforge*" $file_url] &&
+ [string match "*failedmirror*" $effectiveURL]} {
+
+ # *SourceForge hackage in effect*
+ # The url seen by curl seems to have been a redirect to the sourceforge mirror page
+ ui_debug "[msgcat::mc "Fetching from sourceforge mirror failed"]"
+ file delete -force "${distpath}/${distfile}.TMP"
+
+ # Continue on to try the next mirror, if any
+ } else {
+
+ # Successful fetch
+ set fetched 1
+ break
+
+ }
+
+ } else {
+ ui_debug "[msgcat::mc "Fetching failed:"]: $result"
+ file delete -force "${distpath}/${distfile}.TMP"
+ }
+ }
+ if {![info exists fetched]} {
+ return -code error [msgcat::mc "fetch failed"]
+ }
+ }
+ }
return 0
}
# Utility function to delete fetched files.
proc portfetch::fetch_deletefiles {args} {
- global distpath
+ global distpath
variable fetch_urls
- foreach {url_var distfile} $fetch_urls {
- if {[file isfile $distpath/$distfile]} {
- file delete -force "${distpath}/${distfile}"
- }
- }
+ foreach {url_var distfile} $fetch_urls {
+ if {[file isfile $distpath/$distfile]} {
+ file delete -force "${distpath}/${distfile}"
+ }
+ }
}
# Utility function to add files to a list of fetched files.
proc portfetch::fetch_addfilestomap {filemapname} {
- global distpath $filemapname
+ global distpath $filemapname
variable fetch_urls
- foreach {url_var distfile} $fetch_urls {
- if {[file isfile $distpath/$distfile]} {
- filemap set $filemapname $distpath/$distfile 1
- }
- }
+ foreach {url_var distfile} $fetch_urls {
+ if {[file isfile $distpath/$distfile]} {
+ filemap set $filemapname $distpath/$distfile 1
+ }
+ }
}
# Initialize fetch target and call checkfiles.
proc portfetch::fetch_init {args} {
global distfiles distname distpath all_dist_files dist_subdir fetch.type fetch_init_done
global altprefix usealtworkpath
-
+
if {[info exists distpath] && [info exists dist_subdir] && ![info exists fetch_init_done]} {
# start gsoc08-privileges
@@ -757,7 +757,7 @@
proc portfetch::fetch_start {args} {
global UI_PREFIX portname
-
+
ui_msg "$UI_PREFIX [format [msgcat::mc "Fetching %s"] $portname]"
}
@@ -772,14 +772,14 @@
if {![info exists all_dist_files] && "${fetch.type}" == "standard"} {
return 0
}
-
+
# Fetch the files
switch -- "${fetch.type}" {
- cvs { return [cvsfetch] }
- svn { return [svnfetch] }
- git { return [gitfetch] }
- hg { return [hgfetch] }
- standard -
- default { return [portfetch::fetchfiles] }
+ cvs { return [cvsfetch] }
+ svn { return [svnfetch] }
+ git { return [gitfetch] }
+ hg { return [hgfetch] }
+ standard -
+ default { return [portfetch::fetchfiles] }
}
}
Modified: branches/images-and-archives/base/src/port1.0/portlivecheck.tcl
===================================================================
--- branches/images-and-archives/base/src/port1.0/portlivecheck.tcl 2009-05-04 04:15:01 UTC (rev 50562)
+++ branches/images-and-archives/base/src/port1.0/portlivecheck.tcl 2009-05-04 06:22:25 UTC (rev 50563)
@@ -18,7 +18,7 @@
# 3. Neither the name of Apple Computer, Inc. nor the names of its
# contributors may be used to endorse or promote products derived from
# this software without specific prior written permission.
-#
+#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
@@ -62,7 +62,7 @@
global fetch.user fetch.password fetch.use_epsv fetch.ignore_sslcert
global homepage portname portpath workpath
global master_sites name distfiles
-
+
set updated 0
set updated_version "unknown"
set has_master_sites [info exists master_sites]
@@ -111,16 +111,16 @@
# Copied over from portfetch in parts
set fetch_options {}
- if {[string length ${fetch.user}] || [string length ${fetch.password}]} {
- lappend fetch_options -u
- lappend fetch_options "${fetch.user}:${fetch.password}"
- }
- if {${fetch.use_epsv} != "yes"} {
- lappend fetch_options "--disable-epsv"
- }
- if {${fetch.ignore_sslcert} != "no"} {
- lappend fetch_options "--ignore-ssl-cert"
- }
+ if {[string length ${fetch.user}] || [string length ${fetch.password}]} {
+ lappend fetch_options -u
+ lappend fetch_options "${fetch.user}:${fetch.password}"
+ }
+ if {${fetch.use_epsv} != "yes"} {
+ lappend fetch_options "--disable-epsv"
+ }
+ if {${fetch.ignore_sslcert} != "no"} {
+ lappend fetch_options "--ignore-ssl-cert"
+ }
# Perform the check depending on the type.
switch ${livecheck.check} {
@@ -170,10 +170,10 @@
set livecheck.check "regex"
}
}
-
+
# de-escape livecheck.url
set livecheck.url [join ${livecheck.url}]
-
+
switch ${livecheck.check} {
"regex" -
"regexm" {
Modified: branches/images-and-archives/base/src/port1.0/portmirror.tcl
===================================================================
--- branches/images-and-archives/base/src/port1.0/portmirror.tcl 2009-05-04 04:15:01 UTC (rev 50562)
+++ branches/images-and-archives/base/src/port1.0/portmirror.tcl 2009-05-04 06:22:25 UTC (rev 50563)
@@ -18,7 +18,7 @@
# 3. Neither the name of Apple Computer, Inc. nor the names of its
# contributors may be used to endorse or promote products derived from
# this software without specific prior written permission.
-#
+#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
@@ -52,37 +52,37 @@
# It also records the path in a database.
proc portmirror::mirror_main {args} {
- global fetch.type portname mirror_filemap ports_mirror_new portdbpath
-
- set mirror_filemap_path [file join $portdbpath distfiles_mirror.db]
- if {![info exists mirror_filemap]
- && [info exists ports_mirror_new]
- && $ports_mirror_new == "yes"
- && [file exists $mirror_filemap_path]} {
- # Trash the map file if it existed.
- file delete -force $mirror_filemap_path
- }
-
- filemap open mirror_filemap $mirror_filemap_path
+ global fetch.type portname mirror_filemap ports_mirror_new portdbpath
- # Check the distfiles if it's a regular fetch phase.
- if {"${fetch.type}" == "standard"} {
- # fetch the files.
- portfetch::fetch_init $args
- #fetch_start
- portfetch::fetch_main $args
+ set mirror_filemap_path [file join $portdbpath distfiles_mirror.db]
+ if {![info exists mirror_filemap]
+ && [info exists ports_mirror_new]
+ && $ports_mirror_new == "yes"
+ && [file exists $mirror_filemap_path]} {
+ # Trash the map file if it existed.
+ file delete -force $mirror_filemap_path
+ }
- # checksum the files.
- #checksum_start
- if {[catch {portchecksum::checksum_main $args}]} {
- # delete the files.
- portfetch::fetch_deletefiles $args
- } else {
- # add the list of files.
- portfetch::fetch_addfilestomap mirror_filemap
- }
- }
+ filemap open mirror_filemap $mirror_filemap_path
- # close the filemap.
- filemap close mirror_filemap
+ # Check the distfiles if it's a regular fetch phase.
+ if {"${fetch.type}" == "standard"} {
+ # fetch the files.
+ portfetch::fetch_init $args
+ #fetch_start
+ portfetch::fetch_main $args
+
+ # checksum the files.
+ #checksum_start
+ if {[catch {portchecksum::checksum_main $args}]} {
+ # delete the files.
+ portfetch::fetch_deletefiles $args
+ } else {
+ # add the list of files.
+ portfetch::fetch_addfilestomap mirror_filemap
+ }
+ }
+
+ # close the filemap.
+ filemap close mirror_filemap
}
Modified: branches/images-and-archives/base/src/port1.0/portpatch.tcl
===================================================================
--- branches/images-and-archives/base/src/port1.0/portpatch.tcl 2009-05-04 04:15:01 UTC (rev 50562)
+++ branches/images-and-archives/base/src/port1.0/portpatch.tcl 2009-05-04 06:22:25 UTC (rev 50563)
@@ -16,7 +16,7 @@
# 3. Neither the name of Apple Computer, Inc. nor the names of its contributors
# may be used to endorse or promote products derived from this software
# without specific prior written permission.
-#
+#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
@@ -35,7 +35,7 @@
set org.macports.patch [target_new org.macports.patch portpatch::patch_main]
target_provides ${org.macports.patch} patch
-target_requires ${org.macports.patch} main fetch checksum extract
+target_requires ${org.macports.patch} main fetch checksum extract
namespace eval portpatch {
}
@@ -54,48 +54,48 @@
proc portpatch::patch_main {args} {
global UI_PREFIX
-
+
# First make sure that patchfiles exists and isn't stubbed out.
if {![exists patchfiles]} {
- return 0
+ return 0
}
-
- ui_msg "$UI_PREFIX [format [msgcat::mc "Applying patches to %s"] [option portname]]"
-
- # start gsoc08-privileges
+
+ ui_msg "$UI_PREFIX [format [msgcat::mc "Applying patches to %s"] [option portname]]"
+
+ # start gsoc08-privileges
if { [tbool patch.asroot] } {
- # if port is marked as needing root
- elevateToRoot "patch"
- }
- # end gsoc08-privileges
+ # if port is marked as needing root
+ elevateToRoot "patch"
+ }
+ # end gsoc08-privileges
foreach patch [option patchfiles] {
set patch_file [getdistname $patch]
- if {[file exists [option filespath]/$patch_file]} {
- lappend patchlist [option filespath]/$patch_file
- } elseif {[file exists [option distpath]/$patch_file]} {
- lappend patchlist [option distpath]/$patch_file
- } else {
- return -code error [format [msgcat::mc "Patch file %s is missing"] $patch]
- }
+ if {[file exists [option filespath]/$patch_file]} {
+ lappend patchlist [option filespath]/$patch_file
+ } elseif {[file exists [option distpath]/$patch_file]} {
+ lappend patchlist [option distpath]/$patch_file
+ } else {
+ return -code error [format [msgcat::mc "Patch file %s is missing"] $patch]
}
+ }
if {![info exists patchlist]} {
- return -code error [msgcat::mc "Patch files missing"]
+ return -code error [msgcat::mc "Patch files missing"]
}
_cd [option worksrcpath]
foreach patch $patchlist {
- ui_info "$UI_PREFIX [format [msgcat::mc "Applying %s"] $patch]"
- if {[option os.platform] == "linux"} {
- set gzcat "zcat"
- } else {
- set gzcat "gzcat"
- }
- switch -glob -- [file tail $patch] {
- *.Z -
- *.gz {command_exec patch "$gzcat \"$patch\" | (" ")"}
- *.bz2 {command_exec patch "bzcat \"$patch\" | (" ")"}
- default {command_exec patch "" "< '$patch'"}
- }
+ ui_info "$UI_PREFIX [format [msgcat::mc "Applying %s"] $patch]"
+ if {[option os.platform] == "linux"} {
+ set gzcat "zcat"
+ } else {
+ set gzcat "gzcat"
}
+ switch -glob -- [file tail $patch] {
+ *.Z -
+ *.gz {command_exec patch "$gzcat \"$patch\" | (" ")"}
+ *.bz2 {command_exec patch "bzcat \"$patch\" | (" ")"}
+ default {command_exec patch "" "< '$patch'"}
+ }
+ }
return 0
}
Modified: branches/images-and-archives/base/src/port1.0/portsubmit.tcl
===================================================================
--- branches/images-and-archives/base/src/port1.0/portsubmit.tcl 2009-05-04 04:15:01 UTC (rev 50562)
+++ branches/images-and-archives/base/src/port1.0/portsubmit.tcl 2009-05-04 06:22:25 UTC (rev 50563)
@@ -16,7 +16,7 @@
# 3. Neither the name of Apple Computer, Inc. nor the names of its contributors
# may be used to endorse or promote products derived from this software
# without specific prior written permission.
-#
+#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
@@ -36,7 +36,7 @@
set org.macports.submit [target_new org.macports.submit portsubmit::submit_main]
target_runtype ${org.macports.submit} always
-target_provides ${org.macports.submit} submit
+target_provides ${org.macports.submit} submit
target_requires ${org.macports.submit} portpkg
namespace eval portsubmit {
@@ -47,32 +47,32 @@
# escape quotes, and things that make the shell cry
proc portsubmit::shell_escape {str} {
- regsub -all -- {\\} $str {\\\\} str
- regsub -all -- {"} $str {\"} str
- regsub -all -- {'} $str {\'} str
- return $str
+ regsub -all -- {\\} $str {\\\\} str
+ regsub -all -- {"} $str {\"} str
+ regsub -all -- {'} $str {\'} str
+ return $str
}
proc portsubmit::submit_main {args} {
global mp_remote_submit_url portname portversion portverbose prefix UI_PREFIX workpath portpath
-
+
set submiturl $mp_remote_submit_url
-
+
# Preconditions for submit
if {$submitter_email == ""} {
- return -code error [format [msgcat::mc "Submitter email is required to submit a port"]]
+ return -code error [format [msgcat::mc "Submitter email is required to submit a port"]]
}
# Make sure we have a work directory
file mkdir ${workpath}
-
- # Create portpkg.xar in the work directory
- set pkgpath "${workpath}/${portname}.portpkg"
-
- # TODO: If a private key was provided, create a signed digest of the submission
-
- # Submit to the submit url
+
+ # Create portpkg.xar in the work directory
+ set pkgpath "${workpath}/${portname}.portpkg"
+
+ # TODO: If a private key was provided, create a signed digest of the submission
+
+ # Submit to the submit url
set args "curl"
lappend args "--silent"
lappend args "--url ${submiturl}"
@@ -83,47 +83,47 @@
set cmd [join $args]
if {[tbool portverbose]} {
- ui_msg "Submitting portpkg $pkgpath for $portname to $submiturl"
+ ui_msg "Submitting portpkg $pkgpath for $portname to $submiturl"
}
-
- # Invoke curl to do the submit
+
+ # Invoke curl to do the submit
ui_debug $cmd
if {[system $cmd] != ""} {
- return -code error [format [msgcat::mc "Failure during submit of port %s"] $portname]
+ return -code error [format [msgcat::mc "Failure during submit of port %s"] $portname]
}
- # Parse the result
- set fd [open ${workpath}/.portsubmit.out r]
- array set result [list]
- while {[gets $fd line] != -1} {
- if {0 != [regexp -- {^([^:]+):\s*(.*)$} $line unused key value]} {
- set result($key) $value
- }
- }
- close $fd
-
- # Interpret and act on the result
- if {[info exists result(MESSAGE)] && [tbool portverbose]} {
- ui_msg $result(MESSAGE)
- }
- if {[info exists result(STATUS)]} {
- if { $result(STATUS) == 0 } {
- ui_msg "Submitted portpkg for $portname"
- if {[info exists result(DOWNLOAD_URL)]} {
- ui_msg " download URL => $result(DOWNLOAD_URL)"
- }
- if {[info exists result(HUMAN_URL)]} {
- ui_msg " human readable URL => $result(HUMAN_URL)"
- }
- } else {
- return -code error [format [msgcat::mc "Status %d reported during submit of port %s"] $result(STATUS) $portname]
- }
- } else {
- return -code error [format [msgcat::mc "Status not received during submit of port %s"] $portname]
- }
+ # Parse the result
+ set fd [open ${workpath}/.portsubmit.out r]
+ array set result [list]
+ while {[gets $fd line] != -1} {
+ if {0 != [regexp -- {^([^:]+):\s*(.*)$} $line unused key value]} {
+ set result($key) $value
+ }
+ }
+ close $fd
+ # Interpret and act on the result
+ if {[info exists result(MESSAGE)] && [tbool portverbose]} {
+ ui_msg $result(MESSAGE)
+ }
+ if {[info exists result(STATUS)]} {
+ if { $result(STATUS) == 0 } {
+ ui_msg "Submitted portpkg for $portname"
+ if {[info exists result(DOWNLOAD_URL)]} {
+ ui_msg " download URL => $result(DOWNLOAD_URL)"
+ }
+ if {[info exists result(HUMAN_URL)]} {
+ ui_msg " human readable URL => $result(HUMAN_URL)"
+ }
+ } else {
+ return -code error [format [msgcat::mc "Status %d reported during submit of port %s"] $result(STATUS) $portname]
+ }
+ } else {
+ return -code error [format [msgcat::mc "Status not received during submit of port %s"] $portname]
+ }
+
return
-
+
# REMNANTS OF KEVIN'S CODE
# start with the Portfile, and add the files directory if it exists.
@@ -136,29 +136,29 @@
}
if {[system $cmd] != ""} {
- return -code error [format [msgcat::mc "Failed to archive port : %s"] $portname]
+ return -code error [format [msgcat::mc "Failed to archive port : %s"] $portname]
}
- set portsource ""
- set base_rev ""
- if {![catch {set fd [open ".mports_source" r]}]} {
- while {[gets $fd line] != -1} {
- regexp -- {^(.*): (.*)$} $line unused key value
- switch -- $key {
- source { set portsource $value }
- revision { set base_rev $value }
- }
- }
- close $fd
- }
- if {$portsource == ""} {
- ui_msg "$UI_PREFIX Submitting $portname-$portversion"
- puts -nonewline "URL: "
- flush stdout
- gets stdin portsource
- }
+ set portsource ""
+ set base_rev ""
+ if {![catch {set fd [open ".mports_source" r]}]} {
+ while {[gets $fd line] != -1} {
+ regexp -- {^(.*): (.*)$} $line unused key value
+ switch -- $key {
+ source { set portsource $value }
+ revision { set base_rev $value }
+ }
+ }
+ close $fd
+ }
+ if {$portsource == ""} {
+ ui_msg "$UI_PREFIX Submitting $portname-$portversion"
+ puts -nonewline "URL: "
+ flush stdout
+ gets stdin portsource
+ }
- ui_msg "$UI_PREFIX Submitting $portname-$portversion to $portsource"
+ ui_msg "$UI_PREFIX Submitting $portname-$portversion to $portsource"
puts -nonewline "Username: "
flush stdout
@@ -169,13 +169,13 @@
gets stdin password
puts ""
exec stty echo
-
+
set vars {portname portversion maintainers categories description \
- long_description master_sites}
- eval "global $vars"
- foreach var $vars {
- if {![info exists $var]} { set $var {} }
- }
+ long_description master_sites}
+ eval "global $vars"
+ foreach var $vars {
+ if {![info exists $var]} { set $var {} }
+ }
set cmd "curl "
append cmd "--silent "
@@ -196,68 +196,68 @@
ui_debug $cmd
if {[system $cmd] != ""} {
- return -code error [format [msgcat::mc "Failed to submit port : %s"] $portname]
+ return -code error [format [msgcat::mc "Failed to submit port : %s"] $portname]
}
- #
- # Parse the result from the remote index
- # if ERROR: print the error message
- # if OK: store the revision info
- # if CONFLICT: attempt to merge the conflict
- #
-
- set fd [open ${workpath}/.portsubmit.out r]
- array set result [list]
- while {[gets $fd line] != -1} {
- regexp -- {^(.*): (.*)$} $line unused key value
- set result($key) $value
- }
- close $fd
+ #
+ # Parse the result from the remote index
+ # if ERROR: print the error message
+ # if OK: store the revision info
+ # if CONFLICT: attempt to merge the conflict
+ #
- if {[info exists result(OK)]} {
- set fd [open ".mports_source" w]
- puts $fd "source: $portsource"
- puts $fd "port: $portname"
- puts $fd "version: $portversion"
- puts $fd "revision: $result(revision)"
- close $fd
-
- ui_msg "$portname-$portversion submitted successfully."
- ui_msg "New revision: $result(revision)"
- } elseif {[info exists result(ERROR)]} {
- return -code error $result(ERROR)
- } elseif {[info exists result(CONFLICT)]} {
- # Fetch the newer revision from the index.
- # XXX: many gross hacks here regarding paths, urls, etc.
- set tmpdir [mktemp "/tmp/mports.XXXXXXXX"]
- file mkdir $tmpdir/new
- file mkdir $tmpdir/old
- set worker [mport_open $portsource/files/$portname/$portversion/$result(revision)/Portfile.tar.gz [list portdir $tmpdir/new]]
- if {$base_rev != ""} {
- set worker2 [mport_open $portsource/files/$portname/$portversion/$base_rev/Portfile.tar.gz [list portdir $tmpdir/old]]
- catch {system "diff3 -m -E -- $portpath/Portfile $tmpdir/old/$portname-$portversion/Portfile $tmpdir/new/$portname-$portversion/Portfile > $tmpdir/Portfile"}
- file rename -force "${tmpdir}/Portfile" "${portpath}/Portfile"
- mport_close $worker2
- } else {
- catch {system "diff3 -m -E -- $portpath/Portfile $portpath/Portfile $tmpdir/new/$portname-$portversion/Portfile > $tmpdir/Portfile"}
- file rename -force "${tmpdir}/Portfile" "${portpath}/Portfile"
- }
- mport_close $worker
- catch {delete "${tmpdir}"}
+ set fd [open ${workpath}/.portsubmit.out r]
+ array set result [list]
+ while {[gets $fd line] != -1} {
+ regexp -- {^(.*): (.*)$} $line unused key value
+ set result($key) $value
+ }
+ close $fd
- set fd [open [file join "$portpath" ".mports_source"] w]
- puts $fd "source: $portsource"
- puts $fd "port: $portname"
- puts $fd "version: $portversion"
- puts $fd "revision: $result(revision)"
- close $fd
-
- ui_error "A newer revision of this port has already been submitted."
- ui_error "Portfile: $portname-$portversion"
- ui_error "Base revision: $base_rev"
- ui_error "Current revision: $result(revision)"
- ui_error "Please edit the Portfile to resolve any conflicts and resubmit."
- }
+ if {[info exists result(OK)]} {
+ set fd [open ".mports_source" w]
+ puts $fd "source: $portsource"
+ puts $fd "port: $portname"
+ puts $fd "version: $portversion"
+ puts $fd "revision: $result(revision)"
+ close $fd
+ ui_msg "$portname-$portversion submitted successfully."
+ ui_msg "New revision: $result(revision)"
+ } elseif {[info exists result(ERROR)]} {
+ return -code error $result(ERROR)
+ } elseif {[info exists result(CONFLICT)]} {
+ # Fetch the newer revision from the index.
+ # XXX: many gross hacks here regarding paths, urls, etc.
+ set tmpdir [mktemp "/tmp/mports.XXXXXXXX"]
+ file mkdir $tmpdir/new
+ file mkdir $tmpdir/old
+ set worker [mport_open $portsource/files/$portname/$portversion/$result(revision)/Portfile.tar.gz [list portdir $tmpdir/new]]
+ if {$base_rev != ""} {
+ set worker2 [mport_open $portsource/files/$portname/$portversion/$base_rev/Portfile.tar.gz [list portdir $tmpdir/old]]
+ catch {system "diff3 -m -E -- $portpath/Portfile $tmpdir/old/$portname-$portversion/Portfile $tmpdir/new/$portname-$portversion/Portfile > $tmpdir/Portfile"}
+ file rename -force "${tmpdir}/Portfile" "${portpath}/Portfile"
+ mport_close $worker2
+ } else {
+ catch {system "diff3 -m -E -- $portpath/Portfile $portpath/Portfile $tmpdir/new/$portname-$portversion/Portfile > $tmpdir/Portfile"}
+ file rename -force "${tmpdir}/Portfile" "${portpath}/Portfile"
+ }
+ mport_close $worker
+ catch {delete "${tmpdir}"}
+
+ set fd [open [file join "$portpath" ".mports_source"] w]
+ puts $fd "source: $portsource"
+ puts $fd "port: $portname"
+ puts $fd "version: $portversion"
+ puts $fd "revision: $result(revision)"
+ close $fd
+
+ ui_error "A newer revision of this port has already been submitted."
+ ui_error "Portfile: $portname-$portversion"
+ ui_error "Base revision: $base_rev"
+ ui_error "Current revision: $result(revision)"
+ ui_error "Please edit the Portfile to resolve any conflicts and resubmit."
+ }
+
return 0
}
Modified: branches/images-and-archives/base/src/port1.0/porttest.tcl
===================================================================
--- branches/images-and-archives/base/src/port1.0/porttest.tcl 2009-05-04 04:15:01 UTC (rev 50562)
+++ branches/images-and-archives/base/src/port1.0/porttest.tcl 2009-05-04 06:22:25 UTC (rev 50563)
@@ -14,7 +14,7 @@
}
# define options
-options test.run test.target
+options test.run test.target
commands test
# Set defaults
@@ -33,9 +33,9 @@
proc porttest::test_main {args} {
global portname test.run
if {[tbool test.run]} {
- command_exec test
+ command_exec test
} else {
- return -code error [format [msgcat::mc "%s has no tests turned on. see 'test.run' in portfile(7)"] $portname]
+ return -code error [format [msgcat::mc "%s has no tests turned on. see 'test.run' in portfile(7)"] $portname]
}
return 0
}
Modified: branches/images-and-archives/base/src/port1.0/porttrace.tcl
===================================================================
--- branches/images-and-archives/base/src/port1.0/porttrace.tcl 2009-05-04 04:15:01 UTC (rev 50562)
+++ branches/images-and-archives/base/src/port1.0/porttrace.tcl 2009-05-04 06:22:25 UTC (rev 50563)
@@ -18,7 +18,7 @@
# 3. Neither the name of Apple Computer, Inc. nor the names of its
# contributors may be used to endorse or promote products derived from
# this software without specific prior written permission.
-#
+#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
@@ -39,72 +39,72 @@
}
proc porttrace::trace_start {workpath} {
- global os.platform
- if {${os.platform} == "darwin"} {
- if {[catch {package require Thread} error]} {
- ui_warn "trace requires Tcl Thread package ($error)"
- } else {
- global env trace_fifo trace_sandboxbounds portpath
- # Create a fifo.
- # path in unix socket limited to 109 chars
- # # set trace_fifo "$workpath/trace_fifo"
- set trace_fifo "/tmp/macports/[pid]_[expr {int(rand()*1000)}]"
- file mkdir "/tmp/macports"
- file delete -force $trace_fifo
-
- # Create the thread/process.
- create_slave $workpath $trace_fifo
-
- # Launch darwintrace.dylib.
-
- set tracelib_path [file join ${portutil::autoconf::prefix} share macports Tcl darwintrace1.0 darwintrace.dylib]
+ global os.platform
+ if {${os.platform} == "darwin"} {
+ if {[catch {package require Thread} error]} {
+ ui_warn "trace requires Tcl Thread package ($error)"
+ } else {
+ global env trace_fifo trace_sandboxbounds portpath
+ # Create a fifo.
+ # path in unix socket limited to 109 chars
+ # # set trace_fifo "$workpath/trace_fifo"
+ set trace_fifo "/tmp/macports/[pid]_[expr {int(rand()*1000)}]"
+ file mkdir "/tmp/macports"
+ file delete -force $trace_fifo
- if {[info exists env(DYLD_INSERT_LIBRARIES)] && [string length "$env(DYLD_INSERT_LIBRARIES)"] > 0} {
- set env(DYLD_INSERT_LIBRARIES) "${env(DYLD_INSERT_LIBRARIES)}:${tracelib_path}"
- } else {
- set env(DYLD_INSERT_LIBRARIES) ${tracelib_path}
- }
- set env(DYLD_FORCE_FLAT_NAMESPACE) 1
- set env(DARWINTRACE_LOG) "$trace_fifo"
- # The sandbox is limited to:
- # workpath
- # /tmp
- # /private/tmp
- # /var/tmp
- # /private/var/tmp
- # $TMPDIR
- # /dev/null
- # /dev/tty
- # /Library/Caches/com.apple.Xcode
- # $CCACHE_DIR
- # $HOMEDIR/.ccache
- set trace_sandboxbounds "/tmp:/private/tmp:/var/tmp:/private/var/tmp:/dev/:/etc/passwd:/etc/groups:/etc/localtime:/Library/Caches/com.apple.Xcode:$env(HOME)/.ccache:${workpath}:$portpath"
- if {[info exists env(TMPDIR)]} {
- set trace_sandboxbounds "${trace_sandboxbounds}:$env(TMPDIR)"
- }
- if {[info exists env(CCACHE_DIR)]} {
- set trace_sandboxbounds "${trace_sandboxbounds}:$env(CCACHE_DIR)"
- }
- tracelib setsandbox $trace_sandboxbounds
- }
- }
+ # Create the thread/process.
+ create_slave $workpath $trace_fifo
+
+ # Launch darwintrace.dylib.
+
+ set tracelib_path [file join ${portutil::autoconf::prefix} share macports Tcl darwintrace1.0 darwintrace.dylib]
+
+ if {[info exists env(DYLD_INSERT_LIBRARIES)] && [string length "$env(DYLD_INSERT_LIBRARIES)"] > 0} {
+ set env(DYLD_INSERT_LIBRARIES) "${env(DYLD_INSERT_LIBRARIES)}:${tracelib_path}"
+ } else {
+ set env(DYLD_INSERT_LIBRARIES) ${tracelib_path}
+ }
+ set env(DYLD_FORCE_FLAT_NAMESPACE) 1
+ set env(DARWINTRACE_LOG) "$trace_fifo"
+ # The sandbox is limited to:
+ # workpath
+ # /tmp
+ # /private/tmp
+ # /var/tmp
+ # /private/var/tmp
+ # $TMPDIR
+ # /dev/null
+ # /dev/tty
+ # /Library/Caches/com.apple.Xcode
+ # $CCACHE_DIR
+ # $HOMEDIR/.ccache
+ set trace_sandboxbounds "/tmp:/private/tmp:/var/tmp:/private/var/tmp:/dev/:/etc/passwd:/etc/groups:/etc/localtime:/Library/Caches/com.apple.Xcode:$env(HOME)/.ccache:${workpath}:$portpath"
+ if {[info exists env(TMPDIR)]} {
+ set trace_sandboxbounds "${trace_sandboxbounds}:$env(TMPDIR)"
+ }
+ if {[info exists env(CCACHE_DIR)]} {
+ set trace_sandboxbounds "${trace_sandboxbounds}:$env(CCACHE_DIR)"
+ }
+ tracelib setsandbox $trace_sandboxbounds
+ }
+ }
}
# Enable the fence.
# Only done for targets that should only happen in the sandbox.
proc porttrace::trace_enable_fence {} {
- global env trace_sandboxbounds
- set env(DARWINTRACE_SANDBOX_BOUNDS) $trace_sandboxbounds
- tracelib enablefence
+ global env trace_sandboxbounds
+ set env(DARWINTRACE_SANDBOX_BOUNDS) $trace_sandboxbounds
+ tracelib enablefence
}
# Disable the fence.
# Unused yet.
proc porttrace::trace_disable_fence {} {
- global env
- if [info exists env(DARWINTRACE_SANDBOX_BOUNDS)] {
- unset env(DARWINTRACE_SANDBOX_BOUNDS)
- }
+ global env
+ if [info exists env(DARWINTRACE_SANDBOX_BOUNDS)] {
+ unset env(DARWINTRACE_SANDBOX_BOUNDS)
+ }
}
# Check the list of ports.
@@ -112,204 +112,204 @@
# that isn't included in portslist
# This method must be called after trace_start
proc porttrace::trace_check_deps {target portslist} {
- # Get the list of ports.
- set ports [slave_send porttrace::slave_get_ports]
-
- # Compare with portslist
- set portslist [lsort $portslist]
- foreach port $ports {
- if {[lsearch -sorted -exact $portslist $port] == -1} {
- ui_warn "Target $target has an undeclared dependency on $port"
- }
- }
- foreach port $portslist {
- if {[lsearch -sorted -exact $ports $port] == -1} {
- ui_debug "Target $target has no traceable dependency on $port"
- }
- }
+ # Get the list of ports.
+ set ports [slave_send porttrace::slave_get_ports]
+
+ # Compare with portslist
+ set portslist [lsort $portslist]
+ foreach port $ports {
+ if {[lsearch -sorted -exact $portslist $port] == -1} {
+ ui_warn "Target $target has an undeclared dependency on $port"
+ }
+ }
+ foreach port $portslist {
+ if {[lsearch -sorted -exact $ports $port] == -1} {
+ ui_debug "Target $target has no traceable dependency on $port"
+ }
+ }
}
# Check that no violation happened.
# Output a warning for every sandbox violation the trace revealed.
# This method must be called after trace_start
proc porttrace::trace_check_violations {} {
- # Get the list of violations.
- set violations [slave_send porttrace::slave_get_sandbox_violations]
-
- foreach violation [lsort $violations] {
- ui_warn "An activity was attempted outside sandbox: $violation"
- }
+ # Get the list of violations.
+ set violations [slave_send porttrace::slave_get_sandbox_violations]
+
+ foreach violation [lsort $violations] {
+ ui_warn "An activity was attempted outside sandbox: $violation"
+ }
}
# Stop the trace and return the list of ports the port depends on.
# This method must be called after trace_start
proc porttrace::trace_stop {} {
- global os.platform
- if {${os.platform} == "darwin"} {
- global env trace_fifo
- unset env(DYLD_INSERT_LIBRARIES)
- unset env(DYLD_FORCE_FLAT_NAMESPACE)
- unset env(DARWINTRACE_LOG)
- if [info exists env(DARWINTRACE_SANDBOX_BOUNDS)] {
- unset env(DARWINTRACE_SANDBOX_BOUNDS)
- }
-
- #kill socket
- tracelib clean
+ global os.platform
+ if {${os.platform} == "darwin"} {
+ global env trace_fifo
+ unset env(DYLD_INSERT_LIBRARIES)
+ unset env(DYLD_FORCE_FLAT_NAMESPACE)
+ unset env(DARWINTRACE_LOG)
+ if [info exists env(DARWINTRACE_SANDBOX_BOUNDS)] {
+ unset env(DARWINTRACE_SANDBOX_BOUNDS)
+ }
- # Clean up.
- slave_send porttrace::slave_stop
+ #kill socket
+ tracelib clean
- # Delete the slave.
- delete_slave
+ # Clean up.
+ slave_send porttrace::slave_stop
- file delete -force $trace_fifo
- }
+ # Delete the slave.
+ delete_slave
+
+ file delete -force $trace_fifo
+ }
}
# Private
# Create the slave thread.
proc porttrace::create_slave {workpath trace_fifo} {
- global trace_thread
- # Create the thread.
- set trace_thread [macports_create_thread]
-
- # The slave thread requires the registry package.
- thread::send -async $trace_thread "package require registry 1.0"
- # and this file as well.
- thread::send -async $trace_thread "package require porttrace 1.0"
+ global trace_thread
+ # Create the thread.
+ set trace_thread [macports_create_thread]
- # Start the slave work.
- thread::send -async $trace_thread "porttrace::slave_start $trace_fifo $workpath"
+ # The slave thread requires the registry package.
+ thread::send -async $trace_thread "package require registry 1.0"
+ # and this file as well.
+ thread::send -async $trace_thread "package require porttrace 1.0"
+
+ # Start the slave work.
+ thread::send -async $trace_thread "porttrace::slave_start $trace_fifo $workpath"
}
# Private
# Send a command to the thread without waiting for the result.
proc porttrace::slave_send_async {command} {
- global trace_thread
+ global trace_thread
- thread::send -async $trace_thread "$command"
+ thread::send -async $trace_thread "$command"
}
# Private
# Send a command to the thread.
proc porttrace::slave_send {command} {
- global trace_thread
+ global trace_thread
- # ui_warn "slave send $command ?"
+ # ui_warn "slave send $command ?"
- thread::send $trace_thread "$command" result
- return $result
+ thread::send $trace_thread "$command" result
+ return $result
}
# Private
# Destroy the thread.
proc porttrace::delete_slave {} {
- global trace_thread
+ global trace_thread
- # Destroy the thread.
- thread::release $trace_thread
+ # Destroy the thread.
+ thread::release $trace_thread
}
# Private.
# Slave method to read a line from the trace.
proc porttrace::lave_read_line {chan} {
- global ports_list trace_filemap sandbox_violation_list workpath
- global env
+ global ports_list trace_filemap sandbox_violation_list workpath
+ global env
- while 1 {
- # We should never get EOF, actually.
- if {[eof $chan]} {
- break
- }
-
- # The line is of the form: verb\tpath
- # Get the path by chopping it.
- set theline [gets $chan]
-
- if {[fblocked $chan]} {
- # Exit the loop.
- break
- }
+ while 1 {
+ # We should never get EOF, actually.
+ if {[eof $chan]} {
+ break
+ }
- set line_length [string length $theline]
-
- # Skip empty lines.
- if {$line_length > 0} {
- set path_start [expr [string first "\t" $theline] + 1]
- set op [string range $theline 0 [expr $path_start - 2]]
- set path [string range $theline $path_start [expr $line_length - 1]]
-
- # open/execve
- if {$op == "open" || $op == "execve"} {
- # Only work on files.
- if {[file isfile $path]} {
- # Did we process the file yet?
- if {![filemap exists trace_filemap $path]} {
- # Obtain information about this file.
- set port [registry::file_registered $path]
- if { $port != 0 } {
- # Add the port to the list.
- if {[lsearch -sorted -exact $ports_list $port] == -1} {
- lappend ports_list $port
- set ports_list [lsort $ports_list]
- # Maybe fill trace_filemap for efficiency?
- }
- }
-
- # Add the file to the tree with port information.
- # Ignore errors. Errors can occur if a directory was
- # created where a file once lived.
- # This doesn't affect existing ports and we just
- # add this information to speed up port detection.
- catch {filemap set trace_filemap $path $port}
- }
- }
- } elseif {$op == "sandbox_violation"} {
- lappend sandbox_violation_list $path
- }
- }
- }
+ # The line is of the form: verb\tpath
+ # Get the path by chopping it.
+ set theline [gets $chan]
+
+ if {[fblocked $chan]} {
+ # Exit the loop.
+ break
+ }
+
+ set line_length [string length $theline]
+
+ # Skip empty lines.
+ if {$line_length > 0} {
+ set path_start [expr [string first "\t" $theline] + 1]
+ set op [string range $theline 0 [expr $path_start - 2]]
+ set path [string range $theline $path_start [expr $line_length - 1]]
+
+ # open/execve
+ if {$op == "open" || $op == "execve"} {
+ # Only work on files.
+ if {[file isfile $path]} {
+ # Did we process the file yet?
+ if {![filemap exists trace_filemap $path]} {
+ # Obtain information about this file.
+ set port [registry::file_registered $path]
+ if { $port != 0 } {
+ # Add the port to the list.
+ if {[lsearch -sorted -exact $ports_list $port] == -1} {
+ lappend ports_list $port
+ set ports_list [lsort $ports_list]
+ # Maybe fill trace_filemap for efficiency?
+ }
+ }
+
+ # Add the file to the tree with port information.
+ # Ignore errors. Errors can occur if a directory was
+ # created where a file once lived.
+ # This doesn't affect existing ports and we just
+ # add this information to speed up port detection.
+ catch {filemap set trace_filemap $path $port}
+ }
+ }
+ } elseif {$op == "sandbox_violation"} {
+ lappend sandbox_violation_list $path
+ }
+ }
+ }
}
# Private.
# Slave init method.
proc porttrace::slave_start {fifo p_workpath} {
- global ports_list trace_filemap sandbox_violation_list
- # Save the workpath.
- set workpath $p_workpath
- # Create a virtual filemap.
- filemap create trace_filemap
- set ports_list {}
- set sandbox_violation_list {}
- tracelib setname $fifo
- tracelib run
+ global ports_list trace_filemap sandbox_violation_list
+ # Save the workpath.
+ set workpath $p_workpath
+ # Create a virtual filemap.
+ filemap create trace_filemap
+ set ports_list {}
+ set sandbox_violation_list {}
+ tracelib setname $fifo
+ tracelib run
}
# Private.
# Slave cleanup method.
proc porttrace::slave_stop {} {
- global trace_filemap trace_fifo_r_chan trace_fifo_w_chan
- # Close the virtual filemap.
- filemap close trace_filemap
- # Close the pipe (both ends).
+ global trace_filemap trace_fifo_r_chan trace_fifo_w_chan
+ # Close the virtual filemap.
+ filemap close trace_filemap
+ # Close the pipe (both ends).
}
# Private.
# Slave ports export method.
proc porttrace::slave_get_ports {} {
- global ports_list
- return $ports_list
+ global ports_list
+ return $ports_list
}
# Private.
# Slave sandbox violations export method.
proc porttrace::slave_get_sandbox_violations {} {
- global sandbox_violation_list
- return $sandbox_violation_list
+ global sandbox_violation_list
+ return $sandbox_violation_list
}
proc porttrace::slave_add_sandbox_violation {path} {
- global sandbox_violation_list
- lappend sandbox_violation_list $path
+ global sandbox_violation_list
+ lappend sandbox_violation_list $path
}
Modified: branches/images-and-archives/base/src/port1.0/portutil.tcl
===================================================================
--- branches/images-and-archives/base/src/port1.0/portutil.tcl 2009-05-04 04:15:01 UTC (rev 50562)
+++ branches/images-and-archives/base/src/port1.0/portutil.tcl 2009-05-04 06:22:25 UTC (rev 50563)
@@ -18,7 +18,7 @@
# 3. Neither the name of Apple Computer, Inc. nor the names of its contributors
# may be used to endorse or promote products derived from this software
# without specific prior written permission.
-#
+#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
@@ -283,11 +283,11 @@
# composed of the command options.
proc command_string {command} {
global ${command}.dir ${command}.pre_args ${command}.args ${command}.post_args ${command}.cmd
-
+
if {[info exists ${command}.dir]} {
append cmdstring "cd \"[set ${command}.dir]\" &&"
}
-
+
if {[info exists ${command}.cmd]} {
foreach string [set ${command}.cmd] {
append cmdstring " $string"
@@ -332,7 +332,7 @@
}
}
}
-
+
# Set the environment.
# If the array doesn't exist, we create it with the value
# coming from ${command}.env
@@ -344,13 +344,13 @@
if {[option macosx_deployment_target] ne ""} {
set ${command}.env_array(MACOSX_DEPLOYMENT_TARGET) [option macosx_deployment_target]
}
-
+
# Debug that.
ui_debug "Environment: [environment_array_to_string ${command}.env_array]"
# Get the command string.
set cmdstring [command_string ${command}]
-
+
# Call this command.
# TODO: move that to the system native call?
# Save the environment.
@@ -366,13 +366,13 @@
}
# Unset the command array until next time.
array unset ${command}.env_array
-
+
# Restore the environment.
array unset env *
unsetenv *
array set env [array get saved_env]
- # Return as if system had been called directly.
+ # Return as if system had been called directly.
return -code $code $result
}
@@ -452,9 +452,9 @@
set len [llength $args]
set code [lindex $args end]
set args [lrange $args 0 [expr $len - 2]]
-
+
set ditem [variant_new "temp-variant"]
-
+
# mode indicates what the arg is interpreted as.
# possible mode keywords are: requires, conflicts, provides
# The default mode is provides. Arguments are added to the
@@ -466,7 +466,7 @@
provides -
requires -
conflicts { set mode $arg }
- default { ditem_append $ditem $mode $arg }
+ default { ditem_append $ditem $mode $arg }
}
}
ditem_key $ditem name "[join [ditem_key $ditem provides] -]"
@@ -474,7 +474,7 @@
# make a user procedure named variant-blah-blah
# we will call this procedure during variant-run
makeuserproc "variant-[ditem_key $ditem name]" \{$code\}
-
+
# Export provided variant to PortInfo
# (don't list it twice if the variant was already defined, which can happen
# with universal or group code).
@@ -488,7 +488,7 @@
set vinfo($variant_provides) {}
}
array set variant $vinfo($variant_provides)
-
+
# Set conflicts.
set vconflicts [join [lsort [ditem_key $ditem conflicts]]]
if {$vconflicts ne ""} {
@@ -530,7 +530,7 @@
# Returns 1 if variant name selected, otherwise 0
proc variant_isset {name} {
global variations
-
+
if {[info exists variations($name)] && $variations($name) == "+"} {
return 1
}
@@ -555,7 +555,7 @@
set all_variants [lreplace $all_variants $item_index $item_index]
break
}
-
+
incr item_index
}
}
@@ -631,20 +631,20 @@
}
}
-# platform <os> [<release>] [<arch>]
+# platform <os> [<release>] [<arch>]
# Portfile level procedure to provide support for declaring platform-specifics
# Basically, just wrap 'variant', so that Portfiles' platform declarations can
# be more readable, and support arch and version specifics
proc platform {args} {
global all_variants PortInfo os.platform os.arch os.version os.major
-
+
set len [llength $args]
set code [lindex $args end]
set os [lindex $args 0]
set args [lrange $args 1 [expr $len - 2]]
-
+
set ditem [variant_new "temp-variant"]
-
+
foreach arg $args {
if {[regexp {(^[0-9]+$)} $arg match result]} {
set release $result
@@ -652,30 +652,30 @@
set arch $result
}
}
-
+
# Add the variant for this platform
set platform $os
if {[info exists release]} { set platform ${platform}_${release} }
if {[info exists arch]} { set platform ${platform}_${arch} }
-
+
# Pick up a unique name.
if {[variant_exists $platform]} {
set suffix 1
while {[variant_exists "$platform-$suffix"]} {
incr suffix
}
-
+
set platform "$platform-$suffix"
}
variant $platform $code
-
+
# Set the variant if this platform matches the platform we're on
set matches 1
- if {[info exists os.platform] && ${os.platform} == $os} {
+ if {[info exists os.platform] && ${os.platform} == $os} {
set sel_platform $os
if {[info exists os.major] && [info exists release]} {
- if {${os.major} == $release } {
- set sel_platform ${sel_platform}_${release}
+ if {${os.major} == $release } {
+ set sel_platform ${sel_platform}_${release}
} else {
set matches 0
}
@@ -703,7 +703,7 @@
if {[info exists ${command}.env]} {
# Flatten the environment string.
set the_environment [join [set ${command}.env]]
-
+
while {[regexp "^(?: *)(\[^= \]+)=(\"|'|)(\[^\"'\]*?)\\2(?: +|$)(.*)$" ${the_environment} matchVar key delimiter value remaining]} {
set the_environment ${remaining}
set ${command}.env_array(${key}) ${value}
@@ -747,7 +747,7 @@
# Remark: this method is only used for debugging purposes.
proc environment_array_to_string {environment_array} {
upvar 1 ${environment_array} env_array
-
+
set theString ""
foreach {key value} [array get env_array] {
if {$theString == ""} {
@@ -756,7 +756,7 @@
set theString "${theString} $key='$value'"
}
}
-
+
return $theString
}
@@ -809,7 +809,7 @@
# reinplace
# Provides "sed in place" functionality
proc reinplace {args} {
- global euid macportsuser
+ global euid macportsuser
set extended 0
while 1 {
@@ -836,7 +836,7 @@
}
set pattern [lindex $args 0]
set files [lrange $args 1 end]
-
+
foreach file $files {
if {[catch {set tmpfile [mkstemp "/tmp/[file tail $file].sed.XXXXXXXX"]} error]} {
global errorInfo
@@ -849,7 +849,7 @@
# Set tmpfile to only the file name
set tmpfile [join [lrange $tmpfile 1 end]]
}
-
+
set cmdline $portutil::autoconf::sed_command
if {$extended} {
if {$portutil::autoconf::sed_ext_flag == "N/A"} {
@@ -867,13 +867,13 @@
close $tmpfd
return -code error "reinplace sed(1) failed"
}
-
+
close $tmpfd
-
- # start gsoc08-privileges
- chownAsRoot $file
- # end gsoc08-privileges
-
+
+ # start gsoc08-privileges
+ chownAsRoot $file
+ # end gsoc08-privileges
+
set attributes [file attributes $file]
# We need to overwrite this file
if {[catch {file attributes $file -permissions u+w} error]} {
@@ -883,7 +883,7 @@
file delete "$tmpfile"
return -code error "reinplace permissions failed"
}
-
+
if {[catch {file copy -force $tmpfile $file} error]} {
global errorInfo
ui_debug "$errorInfo"
@@ -891,9 +891,9 @@
file delete "$tmpfile"
return -code error "reinplace copy failed"
}
-
+
eval file attributes {$file} $attributes
-
+
file delete "$tmpfile"
}
return
@@ -934,7 +934,7 @@
default {return -code error "touch: illegal option -- $arg"}
}
}
-
+
# parse the r/t options
if {[info exists options(rt)]} {
if {[string equal $options(rt) r]} {
@@ -977,14 +977,14 @@
set atime [clock seconds]
set mtime [clock seconds]
}
-
+
# do we have any files to process?
if {[llength $args] == 0} {
# print usage
ui_msg {usage: touch [-a] [-c] [-m] [-r file] [-t [[CC]YY]MMDDhhmm[.SS]] file ...}
return
}
-
+
foreach file $args {
if {![file exists $file]} {
if {[info exists options(c)]} {
@@ -993,7 +993,7 @@
close [open $file w]
}
}
-
+
if {[info exists options(a)] || ![info exists options(m)]} {
file atime $file $atime
}
@@ -1037,7 +1037,7 @@
default {return -code error "ln: illegal option -- $arg"}
}
}
-
+
if {[llength $args] == 0} {
ui_msg {usage: ln [-f] [-h] [-s] [-v] source_file [target_file]}
ui_msg { ln [-f] [-h] [-s] [-v] file ... directory}
@@ -1049,18 +1049,18 @@
set files [lrange $args 0 [expr [llength $args] - 2]]
set target [lindex $args end]
}
-
+
foreach file $files {
if {[file isdirectory $file] && ![info exists options(s)]} {
return -code error "ln: $file: Is a directory"
}
-
+
if {[file isdirectory $target] && ([file type $target] ne "link" || ![info exists options(h)])} {
set linktarget [file join $target [file tail $file]]
} else {
set linktarget $target
}
-
+
if {![catch {file type $linktarget}]} {
if {[info exists options(f)]} {
file delete $linktarget
@@ -1068,7 +1068,7 @@
return -code error "ln: $linktarget: File exists"
}
}
-
+
if {[llength $files] > 2} {
if {![file exists $linktarget]} {
return -code error "ln: $linktarget: No such file or directory"
@@ -1077,7 +1077,7 @@
return -code error "ln: $target: Not a directory"
}
}
-
+
if {[info exists options(v)]} {
ui_msg "ln: $linktarget -> $file"
}
@@ -1094,7 +1094,7 @@
# Provides searching of the standard path for included files
proc filefindbypath {fname} {
global distpath filesdir worksrcdir portpath
-
+
if {[file readable $portpath/$fname]} {
return $portpath/$fname
} elseif {[file readable $portpath/$filesdir/$fname]} {
@@ -1170,7 +1170,7 @@
foreach m $list {
if {[string first "@" $m] < 0} {
if {[string first ":" $m] >= 0} {
- set m [regsub -- "(.*):(.*)" $m "\\2@\\1"]
+ set m [regsub -- "(.*):(.*)" $m "\\2@\\1"]
} else {
set m "$m at macports.org"
}
@@ -1188,70 +1188,31 @@
set ports_dry_last_skipped ""
proc target_run {ditem} {
- global target_state_fd portpath portname portversion portrevision portvariants ports_force variations workpath ports_trace PortInfo ports_dryrun ports_dry_last_skipped errorisprivileges
+ global target_state_fd portname workpath ports_trace PortInfo ports_dryrun ports_dry_last_skipped errorisprivileges
set result 0
set skipped 0
set procedure [ditem_key $ditem procedure]
-
+
if {[ditem_key $ditem state] != "no"} {
set target_state_fd [open_statefile]
}
-
+
if {$procedure != ""} {
set name [ditem_key $ditem name]
-
+
if {[ditem_contains $ditem init]} {
set result [catch {[ditem_key $ditem init] $name} errstr]
}
-
+
if {$result == 0} {
# Skip the step if required and explain why through ui_debug.
- # 1st case: the step was already done (as mentioned in the state file)
+ # check if the step was already done (as mentioned in the state file)
if {[ditem_key $ditem state] != "no"
&& [check_statefile target $name $target_state_fd]} {
ui_debug "Skipping completed $name ($portname)"
set skipped 1
- # 2nd case: the step is not to always be performed
- # and this exact port/version/revision/variants is already installed
- # and user didn't mention -f
- # and portfile didn't change since installation.
- } elseif {[ditem_key $ditem runtype] != "always"
- && [registry_exists $portname $portversion $portrevision $portvariants]
- && !([info exists ports_force] && $ports_force == "yes")} {
-
- # Did the Portfile change since installation?
- set regref [registry_open $portname $portversion $portrevision $portvariants]
-
- set installdate [registry_prop_retr $regref date]
- if { $installdate != 0
- && $installdate < [file mtime ${portpath}/Portfile]} {
- ui_debug "Portfile changed since installation"
- } else {
- # Say we're skipping.
- set skipped 1
-
- ui_debug "Skipping $name ($portname) since this port is already installed"
- }
-
- # Something to close the registry entry may be called here, if it existed.
- # 3rd case: the same port/version/revision/Variants is already active
- # and user didn't mention -f
- } elseif {$name == "org.macports.activate"
- && [registry_exists $portname $portversion $portrevision $portvariants]
- && !([info exists ports_force] && $ports_force == "yes")} {
-
- # Is port active?
- set regref [registry_open $portname $portversion $portrevision $portvariants]
-
- if { [registry_prop_retr $regref active] != 0 } {
- # Say we're skipping.
- set skipped 1
-
- ui_msg "Skipping $name ($portname $portvariants) since this port is already active"
- }
-
}
-
+
# Of course, if this is a dry run, don't do the task:
if {[info exists ports_dryrun] && $ports_dryrun == "yes"} {
# only one message per portname
@@ -1263,18 +1224,18 @@
}
set skipped 1
}
-
+
# otherwise execute the task.
if {$skipped == 0} {
set target [ditem_key $ditem provides]
-
+
# Execute pre-run procedure
if {[ditem_contains $ditem prerun]} {
set result [catch {[ditem_key $ditem prerun] $name} errstr]
}
-
+
#start tracelib
- if {($result ==0
+ if {($result ==0
&& [info exists ports_trace]
&& $ports_trace == "yes"
&& $target != "clean")} {
@@ -1288,20 +1249,20 @@
&& $target != "install"} {
porttrace::trace_enable_fence
}
-
+
# collect deps
-
+
# Don't check dependencies for extract (they're not honored
# anyway). This avoids warnings about bzip2.
if {$target != "extract"} {
set depends {}
set deptypes {}
-
+
# Determine deptypes to look for based on target
switch $target {
configure -
build { set deptypes "depends_lib depends_build" }
-
+
test -
destroot -
install -
@@ -1317,7 +1278,7 @@
activate -
"" { set deptypes "depends_lib depends_build depends_run" }
}
-
+
# Gather the dependencies for deptypes
foreach deptype $deptypes {
# Add to the list of dependencies if the option exists and isn't empty.
@@ -1325,7 +1286,7 @@
set depends [concat $depends $PortInfo($deptype)]
}
}
-
+
# Dependencies are in the form verb:[param:]port
set depsPorts {}
foreach depspec $depends {
@@ -1338,16 +1299,16 @@
if {$target == "destroot"} {
lappend depsPorts "gzip"
}
-
+
set portlist $depsPorts
foreach depName $depsPorts {
set portlist [recursive_collect_deps $depName $deptypes $portlist]
}
-
+
if {[llength $deptypes] > 0} {tracelib setdeps $portlist}
}
}
-
+
if {$result == 0} {
foreach pre [ditem_key $ditem pre] {
ui_debug "Executing $pre"
@@ -1355,12 +1316,12 @@
if {$result != 0} { break }
}
}
-
+
if {$result == 0} {
ui_debug "Executing $name ($portname)"
set result [catch {$procedure $name} errstr]
}
-
+
if {$result == 0} {
foreach post [ditem_key $ditem post] {
ui_debug "Executing $post"
@@ -1379,11 +1340,11 @@
if {[info exists ports_trace]
&& $ports_trace == "yes"
&& $target!="clean"} {
-
+
tracelib closesocket
-
+
porttrace::trace_check_violations
-
+
# End of trace.
porttrace::trace_stop
}
@@ -1400,21 +1361,21 @@
write_statefile target $name $target_state_fd
}
} else {
- if {$errorisprivileges != "yes"} {
+ if {$errorisprivileges != "yes"} {
global errorInfo
- ui_error "Target $name returned: $errstr"
+ ui_error "Target $name returned: $errstr"
ui_debug "Backtrace: $errorInfo"
} else {
- ui_msg "Target $name returned: $errstr"
+ ui_msg "Target $name returned: $errstr"
}
set result 1
}
-
+
} else {
ui_info "Warning: $name does not have a registered procedure"
set result 1
}
-
+
if {[ditem_key $ditem state] != "no"} {
close $target_state_fd
}
@@ -1446,7 +1407,7 @@
foreach depspec $depends \
{
set portname [lindex [split $depspec :] end]
- if {[lsearch -exact $portdeps $portname] == -1} {
+ if {[lsearch -exact $portdeps $portname] == -1} {
lappend portdeps $portname
set portdeps [recursive_collect_deps $portname $deptypes $portdeps]
}
@@ -1456,14 +1417,37 @@
proc eval_targets {target} {
- global targets target_state_fd portname errorisprivileges
+ global targets target_state_fd portname portversion portrevision portvariants ports_dryrun user_options errorisprivileges
set dlist $targets
set errorisprivileges "no"
-
+
+ # the statefile will likely be autocleaned away after install,
+ # so special-case ignore already-completed install and activate
+ if {[registry_exists $portname $portversion $portrevision $portvariants]} {
+ if {$target == "install"} {
+ ui_debug "Skipping $target ($portname) since this port is already installed"
+ return 0
+ } elseif {$target == "activate"} {
+ set regref [registry_open $portname $portversion $portrevision $portvariants]
+ if {[registry_prop_retr $regref active] != 0} {
+ # Something to close the registry entry may be called here, if it existed.
+ ui_debug "Skipping $target ($portname @${portversion}_${portrevision}${portvariants}) since this port is already active"
+ } else {
+ # do the activate here since target_run doesn't know how to selectively ignore the preceding steps
+ if {[info exists ports_dryrun] && $ports_dryrun == "yes"} {
+ ui_msg "For $portname: skipping $target (dry run)"
+ } else {
+ registry_activate $portname ${portversion}_${portrevision}${portvariants} [array get user_options]
+ }
+ }
+ return 0
+ }
+ }
+
# Select the subset of targets under $target
if {$target != ""} {
set matches [dlist_search $dlist provides $target]
-
+
if {[llength $matches] > 0} {
set dlist [dlist_append_dependents $dlist [lindex $matches 0] [list]]
# Special-case 'all'
@@ -1472,9 +1456,9 @@
return 1
}
}
-
+
set dlist [dlist_eval $dlist "" target_run]
-
+
if {[llength $dlist] > 0} {
# somebody broke!
set errstring "Warning: the following items did not execute (for $portname):"
@@ -1486,13 +1470,13 @@
} else {
set result 0
}
-
+
# start gsoc08-privileges
if { $result == 1 && $errorisprivileges == "yes" } {
- set result 2
+ set result 2
}
# end gsoc08-privileges
-
+
return $result
}
@@ -1501,79 +1485,79 @@
proc open_statefile {args} {
global workpath worksymlink place_worksymlink portname portpath ports_ignore_older
global altprefix usealtworkpath env applications_dir portbuildpath distpath
-
- # start gsoc08-privileges
- # de-escalate privileges - only run if MacPorts was started with sudo
- dropPrivileges
-
+ # start gsoc08-privileges
+
+ # de-escalate privileges - only run if MacPorts was started with sudo
+ dropPrivileges
+
if { ![file exists $workpath] } {
if {[catch {set result [file mkdir $workpath]} result]} {
global errorInfo
ui_debug "mkdir $workpath: $errorInfo"
}
}
-
- # if unable to write to workpath, implies running without either root privileges
+
+ # if unable to write to workpath, implies running without either root privileges
# or a shared directory owned by the group so use ~/.macports
if { ![file writable $workpath] } {
-
- set userid [getuid]
- set username [uid_to_name $userid]
- if { $userid !=0 } {
- ui_msg "MacPorts running without privileges.\
- You may be prompted for your sudo password in order to complete certain actions (eg install)."
- }
-
- # set global variable indicating to other functions to use ~/.macports as well
- set usealtworkpath yes
-
- # do tilde expansion manually - tcl won't expand tildes automatically for curl, etc.
- if {[info exists env(HOME)]} {
- # HOME environment var is set, use it.
- set userhome "$env(HOME)"
- } else {
- # the environment var isn't set, expand ~user instead
- set userhome [file normalize "~${username}"]
- }
-
- # set alternative prefix global variables
- set altprefix "$userhome/.macports"
-
- # get alternative paths
- set newworkpath "$altprefix$workpath"
- set newworksymlink "$altprefix$worksymlink"
- set newportbuildpath "$altprefix$portbuildpath"
- set newdistpath "$altprefix$distpath"
-
- set sourcepath [string map {"work" ""} $worksymlink]
- set newsourcepath "$altprefix/[ string range $sourcepath 1 end ]"
+ set userid [getuid]
+ set username [uid_to_name $userid]
- # copy Portfile (and patch files) if not there already
- # note to maintainers/devs: the original portfile in /opt/local is ALWAYS the one that will be
- # read by macports. The copying of the portfile is done to preserve the symlink provided
- # historically by macports from the portfile directory to the work directory.
- # It is NOT read by MacPorts.
- if {![file exists ${newsourcepath}Portfile] } {
- file mkdir $newsourcepath
- ui_debug "$newsourcepath created"
- ui_debug "Going to copy: ${sourcepath}Portfile"
- file copy ${sourcepath}Portfile $newsourcepath
- if {[file exists ${sourcepath}files] } {
- ui_debug "Going to copy: ${sourcepath}files"
- file copy ${sourcepath}files $newsourcepath
- }
- }
-
- set workpath $newworkpath
- set worksymlink $newworksymlink
- set portbuildpath $newportbuildpath
- set distpath $newdistpath
-
- ui_debug "Going to use $newworkpath for statefile."
+ if { $userid !=0 } {
+ ui_msg "MacPorts running without privileges.\
+ You may be prompted for your sudo password in order to complete certain actions (eg install)."
+ }
+
+ # set global variable indicating to other functions to use ~/.macports as well
+ set usealtworkpath yes
+
+ # do tilde expansion manually - tcl won't expand tildes automatically for curl, etc.
+ if {[info exists env(HOME)]} {
+ # HOME environment var is set, use it.
+ set userhome "$env(HOME)"
+ } else {
+ # the environment var isn't set, expand ~user instead
+ set userhome [file normalize "~${username}"]
+ }
+
+ # set alternative prefix global variables
+ set altprefix "$userhome/.macports"
+
+ # get alternative paths
+ set newworkpath "$altprefix$workpath"
+ set newworksymlink "$altprefix$worksymlink"
+ set newportbuildpath "$altprefix$portbuildpath"
+ set newdistpath "$altprefix$distpath"
+
+ set sourcepath [string map {"work" ""} $worksymlink]
+ set newsourcepath "$altprefix/[ string range $sourcepath 1 end ]"
+
+ # copy Portfile (and patch files) if not there already
+ # note to maintainers/devs: the original portfile in /opt/local is ALWAYS the one that will be
+ # read by macports. The copying of the portfile is done to preserve the symlink provided
+ # historically by macports from the portfile directory to the work directory.
+ # It is NOT read by MacPorts.
+ if {![file exists ${newsourcepath}Portfile] } {
+ file mkdir $newsourcepath
+ ui_debug "$newsourcepath created"
+ ui_debug "Going to copy: ${sourcepath}Portfile"
+ file copy ${sourcepath}Portfile $newsourcepath
+ if {[file exists ${sourcepath}files] } {
+ ui_debug "Going to copy: ${sourcepath}files"
+ file copy ${sourcepath}files $newsourcepath
+ }
+ }
+
+ set workpath $newworkpath
+ set worksymlink $newworksymlink
+ set portbuildpath $newportbuildpath
+ set distpath $newdistpath
+
+ ui_debug "Going to use $newworkpath for statefile."
} else {
- set usealtworkpath no
+ set usealtworkpath no
}
# end gsoc08-privileges
@@ -1594,12 +1578,12 @@
}
}
- # Create a symlink to the workpath for port authors
+ # Create a symlink to the workpath for port authors
if {[tbool place_worksymlink] && ![file isdirectory $worksymlink]} {
ui_debug "Attempting ln -sf $workpath $worksymlink"
ln -sf $workpath $worksymlink
}
-
+
set fd [open $statefile a+]
if {[catch {flock $fd -exclusive -noblock} result]} {
if {"$result" == "EAGAIN"} {
@@ -1642,14 +1626,14 @@
# Check that recorded selection of variants match the current selection
proc check_statefile_variants {variations fd} {
upvar $variations upvariations
-
+
seek $fd 0
while {[gets $fd line] >= 0} {
if {[regexp "variant: (.*)" $line match name]} {
set oldvariations([string range $name 1 end]) [string range $name 0 0]
}
}
-
+
set mismatch 0
if {[array size oldvariations] > 0} {
if {[array size oldvariations] != [array size upvariations]} {
@@ -1663,7 +1647,7 @@
}
}
}
-
+
return $mismatch
}
@@ -1673,9 +1657,9 @@
# will be chosen. Returns a list of the selected variants.
proc choose_variants {dlist variations} {
upvar $variations upvariations
-
+
set selected [list]
-
+
foreach ditem $dlist {
# Enumerate through the provides, tallying the pros and cons.
set pros 0
@@ -1692,9 +1676,9 @@
incr ignored
}
}
-
+
if {$cons > 0} { continue }
-
+
if {$pros > 0 && $ignored == 0} {
lappend selected $ditem
}
@@ -1705,7 +1689,7 @@
proc variant_run {ditem} {
set name [ditem_key $ditem name]
ui_debug "Executing variant $name provides [ditem_key $ditem provides]"
-
+
# test for conflicting variants
foreach v [ditem_key $ditem conflicts] {
if {[variant_isset $v]} {
@@ -1713,7 +1697,7 @@
return 1
}
}
-
+
# execute proc with same name as variant.
if {[catch "variant-${name}" result]} {
global errorInfo
@@ -1725,7 +1709,7 @@
}
# Given a list of variant specifications, return a canonical string form
-# for the registry.
+# for the registry.
# The strategy is as follows: regardless of how some collection of variants
# was turned on or off, a particular instance of the port is uniquely
# characterized by the set of variants that are *on*. Thus, record those
@@ -1755,11 +1739,11 @@
set chosen [choose_variants $dlist upvariations]
set portname $PortInfo(name)
- # Check to make sure the requested variations are available with this
- # port, if one is not, warn the user and remove the variant from the
+ # Check to make sure the requested variations are available with this
+ # port, if one is not, warn the user and remove the variant from the
# array.
foreach key [array names upvariations *] {
- if {![info exists PortInfo(variants)] ||
+ if {![info exists PortInfo(variants)] ||
[lsearch $PortInfo(variants) $key] == -1} {
ui_debug "Requested variant $key is not provided by port $portname."
array unset upvariations $key
@@ -1771,12 +1755,12 @@
#foreach obj $dlist {
# $obj set provides [list [join [$obj get provides] -]]
#}
-
+
set newlist [list]
foreach variant $chosen {
set newlist [dlist_append_dependents $dlist $variant $newlist]
}
-
+
set dlist [dlist_eval $newlist "" variant_run]
if {[llength $dlist] > 0} {
return 1
@@ -1828,7 +1812,7 @@
upvar $variations upvariations
set result 0
set portname $PortInfo(name)
-
+
# Make sure the variations match those stored in the statefile.
# If they don't match, print an error indicating a 'port clean'
# should be performed.
@@ -1848,9 +1832,9 @@
}
if { $statereq &&
!([info exists ports_force] && $ports_force == "yes")} {
-
+
set state_fd [open_statefile]
-
+
if {[check_statefile_variants upvariations $state_fd]} {
ui_error "Requested variants do not match original selection.\nPlease perform 'port clean $portname' or specify the force option."
set result 1
@@ -1860,15 +1844,15 @@
write_statefile variant $upvariations($key)$key $state_fd
}
}
-
+
close $state_fd
}
-
+
return $result
}
proc default_universal_variant_allowed {args} {
-
+
if {[variant_exists universal]} {
ui_debug "universal variant already exists, so not adding the default one"
return no
@@ -1914,12 +1898,12 @@
proc target_new {name procedure} {
global targets
set ditem [ditem_create]
-
+
ditem_key $ditem name $name
ditem_key $ditem procedure $procedure
-
+
lappend targets $ditem
-
+
return $ditem
}
@@ -2071,13 +2055,13 @@
} else {
set options(workpath) ${newworkpath}
}
-
+
set res [mport_lookup $portname]
if {[llength $res] < 2} {
ui_error "Dependency $portname not found"
return -1
}
-
+
array set portinfo [lindex $res 1]
set porturl $portinfo(porturl)
if {[catch {set worker [mport_open $porturl [array get options] $variations]} result]} {
@@ -2094,7 +2078,7 @@
return -1
}
mport_close $worker
-
+
return 0
}
@@ -2112,17 +2096,17 @@
set realname ${name}
set home /dev/null
set shell /dev/null
-
+
foreach arg $args {
if {[regexp {([a-z]*)=(.*)} $arg match key val]} {
set $key $val
}
}
-
+
if {[existsuser ${name}] != 0 || [existsuser ${uid}] != 0} {
return
}
-
+
if {${os.platform} eq "darwin"} {
exec dscl . -create /Users/${name} Password ${passwd}
exec dscl . -create /Users/${name} UniqueID ${uid}
@@ -2143,17 +2127,17 @@
set realname ${name}
set passwd {*}
set users ""
-
+
foreach arg $args {
if {[regexp {([a-z]*)=(.*)} $arg match key val]} {
set $key $val
}
}
-
+
if {[existsgroup ${name}] != 0 || [existsgroup ${gid}] != 0} {
return
}
-
+
if {${os.platform} eq "darwin"} {
exec dscl . -create /Groups/${name} Password ${passwd}
exec dscl . -create /Groups/${name} RealName ${realname}
@@ -2189,12 +2173,12 @@
# returns an error code if it can not be found
proc binaryInPath {binary} {
global env
- foreach dir [split $env(PATH) :] {
+ foreach dir [split $env(PATH) :] {
if {[file executable [file join $dir $binary]]} {
return [file join $dir $binary]
}
}
-
+
return -code error [format [msgcat::mc "Failed to locate '%s' in path: '%s'"] $binary $env(PATH)];
}
@@ -2314,7 +2298,7 @@
# private function
# merge_file base-path target-path relative-path architectures
# e.g. 'merge_file ${workpath}/pre-dest ${destroot} ${prefix}/share/man/man1/port.1 i386 ppc
-# will test equivalence of files and copy them if they are the same (for the different architectures)
+# will test equivalence of files and copy them if they are the same (for the different architectures)
proc merge_file {base target file archs} {
set basearch [lindex ${archs} 0]
ui_debug "ba: '${basearch}' ('${archs}')"
@@ -2395,14 +2379,14 @@
# @param path the file/directory to be chowned
# @param user the user to chown file to
proc chown {path user} {
- lchown $path $user
-
+ lchown $path $user
+
if {[file isdirectory $path]} {
- fs-traverse myfile ${path} {
- lchown $myfile $user
- }
+ fs-traverse myfile ${path} {
+ lchown $myfile $user
+ }
}
-
+
}
##
@@ -2412,18 +2396,18 @@
proc chownAsRoot {path} {
global euid macportsuser
- if { [getuid] == 0 && [geteuid] == [name_to_uid "$macportsuser"] } {
- # if started with sudo but have dropped the privileges
- seteuid $euid
- ui_debug "euid changed to: [geteuid]"
- chown ${path} ${macportsuser}
- ui_debug "chowned $path to $macportsuser"
- seteuid [name_to_uid "$macportsuser"]
- ui_debug "euid changed to: [geteuid]"
- } elseif { [getuid] == 0 } {
- # if started with sudo but have elevated back to root already
- chown ${path} ${macportsuser}
- }
+ if { [getuid] == 0 && [geteuid] == [name_to_uid "$macportsuser"] } {
+ # if started with sudo but have dropped the privileges
+ seteuid $euid
+ ui_debug "euid changed to: [geteuid]"
+ chown ${path} ${macportsuser}
+ ui_debug "chowned $path to $macportsuser"
+ seteuid [name_to_uid "$macportsuser"]
+ ui_debug "euid changed to: [geteuid]"
+ } elseif { [getuid] == 0 } {
+ # if started with sudo but have elevated back to root already
+ chown ${path} ${macportsuser}
+ }
}
##
@@ -2431,51 +2415,51 @@
#
# @param action the action for which privileges are being elevated
proc elevateToRoot {action} {
- global euid egid macportsuser errorisprivileges
-
- if { [getuid] == 0 && [geteuid] == [name_to_uid "$macportsuser"] } {
- # if started with sudo but have dropped the privileges
- ui_debug "Can't run $action on this port without elevated privileges. Escalating privileges back to root."
- setegid $egid
- seteuid $euid
- ui_debug "euid changed to: [geteuid]. egid changed to: [getegid]."
- }
-
- if { [getuid] != 0 } {
- set errorisprivileges yes
- return -code error "port requires root privileges for this action and needs you to type your password for sudo.";
- }
+ global euid egid macportsuser errorisprivileges
+
+ if { [getuid] == 0 && [geteuid] == [name_to_uid "$macportsuser"] } {
+ # if started with sudo but have dropped the privileges
+ ui_debug "Can't run $action on this port without elevated privileges. Escalating privileges back to root."
+ setegid $egid
+ seteuid $euid
+ ui_debug "euid changed to: [geteuid]. egid changed to: [getegid]."
+ }
+
+ if { [getuid] != 0 } {
+ set errorisprivileges yes
+ return -code error "port requires root privileges for this action and needs you to type your password for sudo.";
+ }
}
##
# de-escalate privileges from root to those of $macportsuser.
#
proc dropPrivileges {} {
- global euid egid macportsuser workpath
- if { [geteuid] == 0 } {
- if { [catch {
- set euid [geteuid]
- set egid [getegid]
- ui_debug "changing euid/egid - current euid: $euid - current egid: $egid"
-
- #seteuid [name_to_uid [file attributes $workpath -owner]]
- #setegid [name_to_gid [file attributes $workpath -group]]
-
- setegid [name_to_gid "$macportsuser"]
- seteuid [name_to_uid "$macportsuser"]
- ui_debug "egid changed to: [getegid]"
- ui_debug "euid changed to: [geteuid]"
-
- if {![file writable $workpath]} {
- ui_debug "Privileges successfully de-escalated. Unable to write to default workpath."
- }
- }]
- } {
- ui_debug "$::errorInfo"
- ui_error "Failed to de-escalate privileges."
- }
- } else {
- ui_debug "Privilege de-escalation not attempted as not running as root."
- }
+ global euid egid macportsuser workpath
+ if { [geteuid] == 0 } {
+ if { [catch {
+ set euid [geteuid]
+ set egid [getegid]
+ ui_debug "changing euid/egid - current euid: $euid - current egid: $egid"
+
+ #seteuid [name_to_uid [file attributes $workpath -owner]]
+ #setegid [name_to_gid [file attributes $workpath -group]]
+
+ setegid [name_to_gid "$macportsuser"]
+ seteuid [name_to_uid "$macportsuser"]
+ ui_debug "egid changed to: [getegid]"
+ ui_debug "euid changed to: [geteuid]"
+
+ if {![file writable $workpath]} {
+ ui_debug "Privileges successfully de-escalated. Unable to write to default workpath."
+ }
+ }]
+ } {
+ ui_debug "$::errorInfo"
+ ui_error "Failed to de-escalate privileges."
+ }
+ } else {
+ ui_debug "Privilege de-escalation not attempted as not running as root."
+ }
}
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20090503/5e871b49/attachment-0001.html>
More information about the macports-changes
mailing list