[36679] trunk/base/src
jmr at macports.org
jmr at macports.org
Sun May 11 01:18:25 PDT 2008
Revision: 36679
http://trac.macosforge.org/projects/macports/changeset/36679
Author: jmr at macports.org
Date: 2008-05-11 01:18:24 -0700 (Sun, 11 May 2008)
Log Message:
-----------
fetch_init, archive_init, unarchive_init:
Avoid creating too many subdirectory levels when these procedures are called
more than once. Fix for #11971.
Modified Paths:
--------------
trunk/base/src/package1.0/portarchive.tcl
trunk/base/src/package1.0/portunarchive.tcl
trunk/base/src/port1.0/portfetch.tcl
Modified: trunk/base/src/package1.0/portarchive.tcl
===================================================================
--- trunk/base/src/package1.0/portarchive.tcl 2008-05-11 07:42:14 UTC (rev 36678)
+++ trunk/base/src/package1.0/portarchive.tcl 2008-05-11 08:18:24 UTC (rev 36679)
@@ -61,7 +61,7 @@
global variations package.destpath workpath
global ports_force ports_source_only ports_binary_only
global portname portversion portrevision portvariants
- global archive.destpath archive.type archive.file archive.path
+ global archive.destpath archive.type archive.file archive.path archive.fulldestpath
# Check mode in case archive called directly by user
if {[option portarchivemode] != "yes"} {
@@ -82,7 +82,9 @@
# Define archive destination directory and target filename
if {![string equal ${archive.destpath} ${workpath}] && ![string equal ${archive.destpath} ""]} {
- set archive.destpath [file join ${archive.destpath} [option os.platform] [option os.arch]]
+ set archive.fulldestpath [file join ${archive.destpath} [option os.platform] [option os.arch]]
+ } else {
+ set archive.fulldestpath ${archive.destpath}
}
# Determine if archive should be skipped
@@ -100,7 +102,7 @@
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.destpath} ${archive.file}]"
+ set archive.path "[file join ${archive.fulldestpath} ${archive.file}]"
} else {
ui_debug "Skipping [string toupper ${archive.type}] archive: $errmsg"
set unsupported [expr $unsupported + 1]
@@ -238,11 +240,11 @@
global UI_PREFIX variations
global workpath destpath portpath ports_force
global portname portversion portrevision portvariants
- global archive.destpath archive.type archive.file archive.path
+ global archive.fulldestpath archive.type archive.file archive.path
# Create archive destination path (if needed)
- if {![file isdirectory ${archive.destpath}]} {
- system "mkdir -p ${archive.destpath}"
+ if {![file isdirectory ${archive.fulldestpath}]} {
+ system "mkdir -p ${archive.fulldestpath}"
}
# Copy state file into destroot for archiving
@@ -317,7 +319,7 @@
if {[catch {archiveTypeIsSupported ${archive.type}} errmsg] == 0} {
# Define archive file/path
set archive.file "${portname}-${portversion}_${portrevision}${portvariants}.[option os.arch].${archive.type}"
- set archive.path "[file join ${archive.destpath} ${archive.file}]"
+ set archive.path "[file join ${archive.fulldestpath} ${archive.file}]"
# Setup archive command
archive_command_setup
Modified: trunk/base/src/package1.0/portunarchive.tcl
===================================================================
--- trunk/base/src/package1.0/portunarchive.tcl 2008-05-11 07:42:14 UTC (rev 36678)
+++ trunk/base/src/package1.0/portunarchive.tcl 2008-05-11 08:18:24 UTC (rev 36679)
@@ -61,7 +61,7 @@
global UI_PREFIX target_state_fd variations workpath
global ports_force ports_source_only ports_binary_only
global portname portversion portrevision portvariants portpath
- global unarchive.srcpath unarchive.type unarchive.file unarchive.path
+ global unarchive.srcpath unarchive.type unarchive.file unarchive.path unarchive.fullsrcpath
# Check mode in case archive called directly by user
if {[option portarchivemode] != "yes"} {
@@ -82,7 +82,9 @@
# Define archive directory, file, and path
if {![string equal ${unarchive.srcpath} ${workpath}] && ![string equal ${unarchive.srcpath} ""]} {
- set unarchive.srcpath [file join ${unarchive.srcpath} [option os.platform] [option os.arch]]
+ set unarchive.fullsrcpath [file join ${unarchive.srcpath} [option os.platform] [option os.arch]]
+ } else {
+ set unarchive.fullsrcpath ${unarchive.srcpath}
}
# Determine if unarchive should be skipped
@@ -104,7 +106,7 @@
foreach unarchive.type [option portarchivetype] {
if {[catch {archiveTypeIsSupported ${unarchive.type}} errmsg] == 0} {
set unarchive.file "${portname}-${portversion}_${portrevision}${portvariants}.[option os.arch].${unarchive.type}"
- set unarchive.path "[file join ${unarchive.srcpath} ${unarchive.file}]"
+ set unarchive.path "[file join ${unarchive.fullsrcpath} ${unarchive.file}]"
if {[file exist ${unarchive.path}]} {
set found 1
break
Modified: trunk/base/src/port1.0/portfetch.tcl
===================================================================
--- trunk/base/src/port1.0/portfetch.tcl 2008-05-11 07:42:14 UTC (rev 36678)
+++ trunk/base/src/port1.0/portfetch.tcl 2008-05-11 08:18:24 UTC (rev 36679)
@@ -510,13 +510,13 @@
# Perform a standard fetch, assembling fetch urls from
# the listed url varable and associated distfile
proc fetchfiles {args} {
- global distpath all_dist_files UI_PREFIX fetch_urls
+ global fulldistpath all_dist_files UI_PREFIX fetch_urls
global fetch.user fetch.password fetch.use_epsv fetch.ignore_sslcert
global distfile site
global portverbose
- if {![file isdirectory $distpath]} {
- if {[catch {file mkdir $distpath} result]} {
+ if {![file isdirectory $fulldistpath]} {
+ if {[catch {file mkdir $fulldistpath} result]} {
return -code error [format [msgcat::mc "Unable to create distribution files path: %s"] $result]
}
}
@@ -538,10 +538,10 @@
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 {![file isfile [file join $fulldistpath $distfile]]} {
+ ui_info "$UI_PREFIX [format [msgcat::mc "%s doesn't seem to exist in %s"] $distfile $fulldistpath]"
+ if {![file writable $fulldistpath]} {
+ return -code error [format [msgcat::mc "%s must be writable"] $fulldistpath]
}
if {!$sorted} {
sortsites
@@ -558,8 +558,8 @@
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 {system "mv ${distpath}/${distfile}.TMP ${distpath}/${distfile}"}]} {
+ if {![catch {eval curl fetch --effective-url effectiveURL $fetch_options {$file_url} ${fulldistpath}/${distfile}.TMP} result] &&
+ ![catch {system "mv ${fulldistpath}/${distfile}.TMP ${fulldistpath}/${distfile}"}]} {
# Special hack to check for sourceforge mirrors, which don't return a proper error code on failure
if {![string equal $effectiveURL $file_url] &&
@@ -569,7 +569,7 @@
# *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"]"
- exec rm -f ${distpath}/${distfile}.TMP
+ exec rm -f [file join $fulldistpath ${distfile}.TMP]
# Continue on to try the next mirror, if any
} else {
@@ -582,7 +582,7 @@
} else {
ui_debug "[msgcat::mc "Fetching failed:"]: $result"
- exec rm -f ${distpath}/${distfile}.TMP
+ exec rm -f [file join $fulldistpath ${distfile}.TMP]
}
}
if {![info exists fetched]} {
@@ -595,30 +595,34 @@
# Utility function to delete fetched files.
proc fetch_deletefiles {args} {
- global distpath fetch_urls
+ global fulldistpath fetch_urls
foreach {url_var distfile} $fetch_urls {
- if {[file isfile $distpath/$distfile]} {
- exec rm -f ${distpath}/${distfile}
+ if {[file isfile [file join $fulldistpath $distfile]]} {
+ exec rm -f [file join $fulldistpath $distfile]
}
}
}
# Utility function to add files to a list of fetched files.
proc fetch_addfilestomap {filemapname} {
- global distpath fetch_urls $filemapname
+ global fulldistpath fetch_urls $filemapname
foreach {url_var distfile} $fetch_urls {
- if {[file isfile $distpath/$distfile]} {
- filemap set $filemapname $distpath/$distfile 1
+ if {[file isfile [file join $fulldistpath $distfile]]} {
+ filemap set $filemapname [file join $fulldistpath $distfile] 1
}
}
}
# Initialize fetch target
proc fetch_init {args} {
- global distfiles distname distpath all_dist_files dist_subdir fetch.type
+ global distfiles distname distpath fulldistpath all_dist_files dist_subdir fetch.type
- if {[info exist distpath] && [info exists dist_subdir]} {
- set distpath ${distpath}/${dist_subdir}
+ if {[info exist distpath]} {
+ if {[info exists dist_subdir]} {
+ set fulldistpath [file join $distpath $dist_subdir]
+ } else {
+ set fulldistpath $distpath
+ }
}
}
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.macosforge.org/pipermail/macports-changes/attachments/20080511/7aa6a02a/attachment.html
More information about the macports-changes
mailing list