Ticket #29592: image_to_archive.diff

src/images_to_archives.tcl

@@ -33 +33 @@
 set archived_list {}
 
 foreach installed $ilist {
+    puts $installed
     set iname [lindex $installed 0]
     set iversion [lindex $installed 1]
     set irevision [lindex $installed 2]
@@ -49 +50 @@
         set location ""
     }
 
+    puts $location
+
     if {$location == "" || ![file isfile $location]} {
         # no image archive present, so make one
         set archs [registry::property_retrieve $iref archs]
@@ -56 +59 @@
             set archs ${macports::os_arch}
         }
         # look for any existing archive in the old location
-        set oldarchiverootname "${iname}-${iversion}_${irevision}${ivariants}.[join $archs -]"
+        set oldarchiverootname "${iname}-${iversion}_${irevision}${ivariants}.${macports::os_platform}_${macports::os_major}.[join $archs -]"
         set archivetype tbz2
         set oldarchivedir [file join ${macports::portdbpath} packages ${macports::os_platform}_${macports::os_major}]
         set olderarchivedir [file join ${macports::portdbpath} packages ${macports::os_platform}]
@@ -68 +71 @@
             set olderarchivedir [file join $olderarchivedir universal]
         }
         set found 0
-        foreach adir [list $oldarchivedir $olderarchivedir] {
+        foreach adir [list [file dirname $location] $oldarchivedir $olderarchivedir] {
+            puts $adir
             foreach type {tbz2 tbz tgz tar txz tlz xar xpkg zip cpgz cpio} {
                 set oldarchivefullpath "[file join $adir $oldarchiverootname].${type}"
                 if {[file isfile $oldarchivefullpath]} {
@@ -92 +96 @@
         set newlocation [file join $targetdir $archivename]
 
         if {$found} {
-            file rename $oldarchivefullpath $newlocation
+            if {[catch {file rename $oldarchivefullpath $newlocation}]} {
+                puts "Found $archivename (renaming failed)."
+            }
         } elseif {$installtype == "image"} {
-            # create archive from image dir
-            system "cd $location && $tarcmd -cjf $newlocation * > ${targetdir}/error.log 2>&1"
-            file delete -force ${targetdir}/error.log
+            if {! [file isfile $newlocation]} {
+                # create archive from image dir
+                system "cd $location && $tarcmd -cjf $newlocation * > ${targetdir}/error.log 2>&1"
+                file delete -force ${targetdir}/error.log
+            }
         } else {
             # direct mode, create archive from installed files
             # we tell tar to read filenames from a file so as not to run afoul of command line length limits