[89459] trunk/base

jmr at macports.org jmr at macports.org
Mon Jan 30 07:00:00 PST 2012


Revision: 89459
          http://trac.macports.org/changeset/89459
Author:   jmr at macports.org
Date:     2012-01-30 06:59:58 -0800 (Mon, 30 Jan 2012)
Log Message:
-----------
cache ping times for 24 hours and add settings for indicating that certain hosts should be preferred or blacklisted

Modified Paths:
--------------
    trunk/base/portmgr/jobs/port_binary_distributable.tcl
    trunk/base/src/macports1.0/macports.tcl
    trunk/base/src/port1.0/fetch_common.tcl

Modified: trunk/base/portmgr/jobs/port_binary_distributable.tcl
===================================================================
--- trunk/base/portmgr/jobs/port_binary_distributable.tcl	2012-01-30 14:48:47 UTC (rev 89458)
+++ trunk/base/portmgr/jobs/port_binary_distributable.tcl	2012-01-30 14:59:58 UTC (rev 89459)
@@ -37,7 +37,7 @@
 set good_licenses {afl agpl apache apsl artistic autoconf beopen bitstreamvera \
                    boost bsd bsd-old cecill cecill-b cecill-c cnri copyleft \
                    cpl curl epl fpll fontconfig freetype gd gfdl gpl \
-                   gplconflict ibmpl ijg isc  jasper lgpl libtool lppl mit \
+                   gplconflict ibmpl ijg isc jasper lgpl libtool lppl mit \
                    mpl ncsa noncommercial openldap openssl permissive php \
                    psf public-domain qpl restrictive/distributable ruby \
                    sleepycat ssleay tcl/tk vim w3c wtfpl x11 zlib wxwidgets zpl}

Modified: trunk/base/src/macports1.0/macports.tcl
===================================================================
--- trunk/base/src/macports1.0/macports.tcl	2012-01-30 14:48:47 UTC (rev 89458)
+++ trunk/base/src/macports1.0/macports.tcl	2012-01-30 14:59:58 UTC (rev 89459)
@@ -49,7 +49,9 @@
         mp_remote_url mp_remote_submit_url configureccache ccache_dir ccache_size configuredistcc configurepipe buildnicevalue buildmakejobs \
         applications_dir frameworks_dir developer_dir universal_archs build_arch macosx_deployment_target \
         macportsuser proxy_override_env proxy_http proxy_https proxy_ftp proxy_rsync proxy_skip \
-        master_site_local patch_site_local archive_site_local buildfromsource revupgrade_autorun revupgrade_mode revupgrade_check_id_loadcmds"
+        master_site_local patch_site_local archive_site_local buildfromsource \
+        revupgrade_autorun revupgrade_mode revupgrade_check_id_loadcmds \
+        host_blacklist preferred_hosts"
     variable user_options "submitter_name submitter_email submitter_key"
     variable portinterp_options "\
         portdbpath porturl portpath portbuildpath auto_path prefix prefix_frozen portsharepath \
@@ -483,6 +485,9 @@
     global macports::macosx_version
     global macports::macosx_deployment_target
     global macports::archivefetch_pubkeys
+    global macports::ping_cache
+    global macports::host_blacklisted
+    global macports::host_preferred
 
     # Set the system encoding to utf-8
     encoding system utf-8
@@ -981,6 +986,24 @@
     # add ccache to environment
     set env(CCACHE_DIR) ${macports::ccache_dir}
 
+    # load cached ping times
+    if {[catch {
+        set pingfile [open ${macports::portdbpath}/pingtimes r]
+        array set macports::ping_cache [gets $pingfile]
+        close $pingfile
+    }]} { array set macports::ping_cache {} }
+    # set up arrays of blacklisted and preferred hosts
+    if {[info exists macports::host_blacklist]} {
+        foreach host ${macports::host_blacklist} {
+            set macports::host_blacklisted($host) 1
+        }
+    }
+    if {[info exists macports::preferred_hosts]} {
+        foreach host ${macports::preferred_hosts} {
+            set macports::host_preferred($host) 1
+        }
+    }
+
     # load the quick index
     _mports_load_quickindex
 
@@ -1016,6 +1039,13 @@
 
 # call this just before you exit
 proc mportshutdown {} {
+    # save ping times
+    global macports::ping_cache macports::portdbpath
+    catch {
+        set pingfile [open ${macports::portdbpath}/pingtimes w]
+        puts $pingfile [array get macports::ping_cache]
+        close $pingfile
+    }
     # close it down so the cleanup stuff is called, e.g. vacuuming the db
     registry::close
 }
@@ -1103,6 +1133,10 @@
     # deferred options processing.
     $workername alias getoption macports::getoption
 
+    # ping cache
+    $workername alias get_pingtime macports::get_pingtime
+    $workername alias set_pingtime macports::set_pingtime
+
     foreach opt $portinterp_options {
         if {![info exists $opt]} {
             global macports::$opt
@@ -4296,3 +4330,26 @@
     }
 }
 
+# get cached ping time for host, modified by blacklist and preferred list
+proc macports::get_pingtime {host} {
+    global macports::ping_cache macports::host_blacklisted macports::host_preferred
+    if {[info exists host_blacklisted($host)]} {
+        return -1
+    } elseif {[info exists host_preferred($host)]} {
+        return 1
+    } elseif {[info exists ping_cache($host)]} {
+        # expire entries after 1 day
+        if {[expr [clock seconds] - [lindex $ping_cache($host) 1]] <= 86400} {
+            return [lindex $ping_cache($host) 0]
+        } else {
+            unset ping_cache($host)
+        }
+    }
+    return {}
+}
+
+# cache a ping time of ms for host
+proc macports::set_pingtime {host ms} {
+    global macports::ping_cache
+    set ping_cache($host) [list $ms [clock seconds]]
+}

Modified: trunk/base/src/port1.0/fetch_common.tcl
===================================================================
--- trunk/base/src/port1.0/fetch_common.tcl	2012-01-30 14:48:47 UTC (rev 89458)
+++ trunk/base/src/port1.0/fetch_common.tcl	2012-01-30 14:59:58 UTC (rev 89459)
@@ -252,7 +252,7 @@
                 continue
             }
             foreach fallback $fallback_mirror_list {
-                if {[string match [append fallback *] $site]} {
+                if {[string match ${fallback}* $site]} {
                     # don't bother pinging fallback mirrors
                     set seen($host) yes
                     # and make them sort to the very end of the list
@@ -261,25 +261,29 @@
                 }
             }
             if { ![info exists seen($host)] } {
-                if {[catch {set fds($host) [open "|ping -noq -c3 -t3 $host | grep round-trip | cut -d / -f 5"]}]} {
-                    ui_debug "Spawning ping for $host failed"
-                    # will end up after all hosts that were pinged OK but before those that didn't respond
-                    set pingtimes($host) 5000
-                } else {
-                    ui_debug "Pinging $host..."
-                    set seen($host) yes
-                    lappend hosts $host
+                # first check the persistent cache
+                set pingtimes($host) [get_pingtime $host]
+                if {$pingtimes($host) == {}} {
+                    if {[catch {set fds($host) [open "|ping -noq -c3 -t3 $host | grep round-trip | cut -d / -f 5"]}]} {
+                        ui_debug "Spawning ping for $host failed"
+                        # will end up after all hosts that were pinged OK but before those that didn't respond
+                        set pingtimes($host) 5000
+                    } else {
+                        set seen($host) yes
+                        lappend hosts $host
+                    }
                 }
             }
         }
 
         foreach host $hosts {
-            set len [gets $fds($host) pingtimes($host)]
+            gets $fds($host) pingtimes($host)
             if { [catch { close $fds($host) }] || ![string is double -strict $pingtimes($host)] } {
                 # ping failed, so put it last in the list (but before the fallback mirrors)
                 set pingtimes($host) 10000
             }
-            ui_debug "$host ping time is $pingtimes($host)"
+            # cache it
+            set_pingtime $host $pingtimes($host)
         }
 
         if {[info exists oldeuid]} {
@@ -294,7 +298,10 @@
             } else {
                 regexp $hostregex $site -> host
             }
-            lappend pinglist [ list $site $pingtimes($host) ]
+            # -1 means blacklisted
+            if {$pingtimes($host) != "-1"} {
+                lappend pinglist [ list $site $pingtimes($host) ]
+            }
         }
 
         set pinglist [ lsort -real -index 1 $pinglist ]
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20120130/c9a86c91/attachment-0001.html>


More information about the macports-changes mailing list