Revision: 89459 http://trac.macports.org/changeset/89459 Author: jmr@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 ]