[91196] trunk/base/src

[jmr at macports.org]

Revision: 91196
          https://trac.macports.org/changeset/91196
Author:   jmr at macports.org
Date:     2012-03-25 07:13:55 -0700 (Sun, 25 Mar 2012)
Log Message:
-----------
check on packages server when testing if an archive is available

Modified Paths:
--------------
    trunk/base/src/macports1.0/macports.tcl
    trunk/base/src/package1.0/portarchivefetch.tcl
    trunk/base/src/port1.0/portutil.tcl

Modified: trunk/base/src/macports1.0/macports.tcl
===================================================================
--- trunk/base/src/macports1.0/macports.tcl	2012-03-25 14:02:35 UTC (rev 91195)
+++ trunk/base/src/macports1.0/macports.tcl	2012-03-25 14:13:55 UTC (rev 91196)
@@ -3139,7 +3139,7 @@
         mpkg        -
         rpm         -
         dpkg        {
-            if {[$workername eval _archive_available]} {
+            if {[global_option_isset ports_binary_only] || [$workername eval _archive_available]} {
                 return "depends_lib depends_run"
             } else {
                 return "depends_fetch depends_extract depends_build depends_lib depends_run"
@@ -3148,7 +3148,8 @@
         install     -
         activate    -
         ""          {
-            if {[$workername eval registry_exists \$subport \$version \$revision \$portvariants]
+            if {[global_option_isset ports_binary_only] ||
+                [$workername eval registry_exists \$subport \$version \$revision \$portvariants]
                 || [$workername eval _archive_available]} {
                 return "depends_lib depends_run"
             } else {

Modified: trunk/base/src/package1.0/portarchivefetch.tcl
===================================================================
--- trunk/base/src/package1.0/portarchivefetch.tcl	2012-03-25 14:02:35 UTC (rev 91195)
+++ trunk/base/src/package1.0/portarchivefetch.tcl	2012-03-25 14:13:55 UTC (rev 91196)
@@ -65,7 +65,11 @@
 default archive.subdir {${subport}}
 
 proc portarchivefetch::filter_sites {} {
-    global prefix frameworks_dir applications_dir porturl
+    global prefix frameworks_dir applications_dir porturl \
+        portfetch::mirror_sites::sites portfetch::mirror_sites::archive_type \
+        portfetch::mirror_sites::archive_prefix \
+        portfetch::mirror_sites::archive_frameworks_dir \
+        portfetch::mirror_sites::archive_applications_dir
 
     # get defaults from ports tree resources
     set mirrorfile [get_full_archive_sites_path]

Modified: trunk/base/src/port1.0/portutil.tcl
===================================================================
--- trunk/base/src/port1.0/portutil.tcl	2012-03-25 14:02:35 UTC (rev 91195)
+++ trunk/base/src/port1.0/portutil.tcl	2012-03-25 14:13:55 UTC (rev 91196)
@@ -2885,22 +2885,64 @@
 
 # check if we can unarchive this port
 proc _archive_available {} {
-    global ports_source_only porturl
+    global ports_source_only porturl portutil::archive_available_result
 
+    if {[info exists archive_available_result]} {
+        return $archive_available_result
+    }
+
     if {[tbool ports_source_only]} {
+        set archive_available_result 0
         return 0
     }
 
     if {[find_portarchive_path] != ""} {
+        set archive_available_result 1
         return 1
     }
 
-    if {[file rootname [file tail $porturl]] == [file rootname [get_portimage_name]] && [file extension $porturl] != ""} {
+    set archiverootname [file rootname [get_portimage_name]]
+    if {[file rootname [file tail $porturl]] == $archiverootname && [file extension $porturl] != ""} {
+        set archive_available_result 1
         return 1
     }
 
-    # TODO: check if there's an archive available on the server - this
-    # is much less useful otherwise now that archive == installed image
+    # check if there's an archive available on the server
+    global archive_sites
+    set mirrors macports_archives
+    if {[lsearch $archive_sites macports_archives::*] == -1} {
+        set mirrors [lindex [split [lindex $archive_sites 0] :] 0]
+    }
+    if {$mirrors == {}} {
+        set archive_available_result 0
+        return 0
+    }
+    set archivetype $portfetch::mirror_sites::archive_type($mirrors)
+    set archivename "${archiverootname}.${archivetype}"
+    # grab first site, should conventionally be the master mirror
+    set sites_entry [lindex $portfetch::mirror_sites::sites($mirrors) 0]
+    # look for and strip off any tag, which will start with the first colon after the
+    # first slash after the ://
+    set lastcolon [string last : $sites_entry]
+    set aftersep [expr [string first : $sites_entry] + 3]
+    set firstslash [string first / $sites_entry $aftersep]
+    if {$firstslash != -1 && $firstslash < $lastcolon} {
+        incr lastcolon -1
+        set site [string range $sites_entry 0 $lastcolon]
+    } else {
+        set site $sites_entry
+    }
+    if {[string index $site end] != "/"} {
+        append site "/[option archive.subdir]"
+    } else {
+        append site [option archive.subdir]
+    }
+    set url [portfetch::assemble_url $site $archivename]
+    if {![catch {curl getsize $url} result]} {
+        set archive_available_result 1
+        return 1
+    }
 
+    set archive_available_result 0
     return 0
 }
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20120325/b535f6a6/attachment.html>