Changeset 36679

Timestamp:

2008-05-11 01:18:24 (6 months ago)

Author:

jmr@…

Message:

fetch_init, archive_init, unarchive_init:
Avoid creating too many subdirectory levels when these procedures are called
more than once. Fix for #11971.

Location:

trunk/base/src

Files:

• package1.0/portarchive.tcl (modified) (5 diffs)
• package1.0/portunarchive.tcl (modified) (3 diffs)
• port1.0/portfetch.tcl (modified) (8 diffs)

trunk/base/src/package1.0/portarchive.tcl

@@ -62 +62 @@
         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
@@ -83 +83 @@
         # 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}
         }
 
@@ -101 +103 @@
                         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"
@@ -239 +241 @@
         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}"
         }
 
@@ -318 +320 @@
                         # 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

trunk/base/src/package1.0/portunarchive.tcl

@@ -62 +62 @@
         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
@@ -83 +83 @@
         # 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}
         }
 
@@ -105 +107 @@
                         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

trunk/base/src/port1.0/portfetch.tcl

@@ -511 +511 @@
 # 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]
                 }
@@ -539 +539 @@
         
         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} {
@@ -559 +559 @@
                                 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
@@ -570 +570 @@
                                                 # 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
@@ -583 +583 @@
                                 } else {
                                         ui_debug "[msgcat::mc "Fetching failed:"]: $result"
-                                        exec rm -f ${distpath}/${distfile}.TMP
+                                        exec rm -f [file join $fulldistpath ${distfile}.TMP]
                                 }
                         }
@@ -596 +596 @@
 # 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]
                 }
         }
@@ -606 +606 @@
 # 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
                 }
         }
@@ -616 +616 @@
 # Initialize fetch target
 proc fetch_init {args} {
-    global distfiles distname distpath all_dist_files dist_subdir fetch.type
-    
-    if {[info exist distpath] && [info exists dist_subdir]} {
-        set distpath ${distpath}/${dist_subdir}
+    global distfiles distname distpath fulldistpath all_dist_files dist_subdir fetch.type
+    
+    if {[info exist distpath]} {
+        if {[info exists dist_subdir]} {
+            set fulldistpath [file join $distpath $dist_subdir]
+        } else {
+            set fulldistpath $distpath
+        }
     }
 }