Ticket #14891: sortsites4.2.diff

File sortsites4.2.diff, 2.8 KB (added by raimue (Rainer Müller), 17 years ago)
  • src/port1.0/portfetch.tcl

     
    301301    }
    302302}
    303303
     304# sorts fetch_urls in order of ping time
     305proc sortsites {args} {
     306    global fetch_urls fallback_mirror_site
     307
     308    set fallback_mirror_list [mirror_sites $fallback_mirror_site {} {}]
     309
     310    foreach {url_var distfile} $fetch_urls {
     311        global portfetch::$url_var
     312                if {![info exists $url_var]} {
     313                        ui_error [format [msgcat::mc "No defined site for tag: %s, using master_sites"] $url_var]
     314                        set url_var master_sites
     315                        global portfetch::$url_var
     316                }
     317                set urllist [set $url_var]
     318                set hosts {}
     319                set hostregex {[a-zA-Z]+://([a-zA-Z0-9\.\-_]+)}
     320
     321        if {[llength $urllist] - [llength $fallback_mirror_list] <= 1} {
     322            # there is only one mirror, no need to ping or sort
     323            continue
     324        }
     325
     326        foreach site $urllist {
     327            regexp $hostregex $site -> host
     328           
     329            if { [info exists seen($host)] } {
     330                continue
     331            }
     332            foreach fallback $fallback_mirror_list {
     333                if {[string match [append fallback *] $site]} {
     334                    # don't bother pinging fallback mirrors
     335                    set seen($host) yes
     336                    # and make them sort to the very end of the list
     337                    set pingtimes($host) 20000
     338                    break
     339                }
     340            }
     341            if { ![info exists seen($host)] } {
     342                set seen($host) yes
     343                lappend hosts $host
     344                ui_debug "Pinging $host..."
     345                set fds($host) [open "|ping -noq -c3 -t3 $host | grep round-trip | cut -d / -f 5"]
     346            }
     347        }
     348       
     349        foreach host $hosts {
     350            set len [gets $fds($host) pingtimes($host)]
     351            if { [catch { close $fds($host) }] || ![string is double -strict $pingtimes($host)] } {
     352                # ping failed, so put it last in the list (but before the fallback mirrors)
     353                set pingtimes($host) 10000
     354            }
     355            ui_debug "$host ping time is $pingtimes($host)"
     356        }
     357       
     358        set pinglist {}
     359        foreach site $urllist {
     360            regexp $hostregex $site -> host
     361            lappend pinglist [ list $site $pingtimes($host) ]
     362        }
     363
     364        set pinglist [ lsort -real -index 1 $pinglist ]
     365
     366        set $url_var {}
     367        foreach pair $pinglist {
     368            lappend $url_var [lindex $pair 0]
     369        }
     370    }
     371}
     372
    304373# Perform the full checksites/checkpatchfiles/checkdistfiles sequence.
    305374# This method is used by distcheck target.
    306375proc checkfiles {args} {
     
    310379        checksites
    311380        checkpatchfiles
    312381        checkdistfiles
     382        sortsites
    313383}
    314384
    315385