Version 1 of Using http to download from sourceforge

I naively thought that simply following redirects would allow me to download from sourceforge programmatically. Implementation of this is done in the man page for http. Not so! I was always getting the download page. Turns out you have to look for a meta tag in the html to get a url to get a mirror location to use. I updated the http example code to account for this. Hope this helps for other people. - Bezoar

Code

#!/bin/sh
 # the next line restarts using wish \
 exec /opt/usr8.6.3/bin/tclsh8.6  "$0" ${1+"$@"}

foreach pkg { http tls } {
        if { [ catch {package require $pkg } err ] != 0 } {
                puts stderr "Unable to find package $pkg\n$err\n ... adjust your auto_path!";
                }
}
#  this is an example of the tag we look for in the download page
#   <meta http-equiv="refresh" content="5; url=https://downloads.sourceforge.net/project/tcl/Tcl/8.7a5/tcl8.7a5-src.tar.gz?
# ts=gAAAAABg5zxNuNNsM9To4kiiyjEIJhbOTV5LlNwnaCjicKjot0rStktDCGDJIBlH4tSsHYKOZbpHBfPgJBh5cl83IKNJ1tw%3D%3D
# &amp;use_mirror=managedway&amp;r=">
# </noscript>

::http::register https 443 ::tls::socket

# most of code comes from http documentation page examples section
proc httpcopy { url file {chunk 4096} } {
    set out [open "$file" w 0666 ]
        puts "httpcopy : getting $url -> $file "
        flush stdout
    set token [::http::geturl $url -channel $out  \
            -progress httpCopyProgress -blocksize $chunk]
    close $out

    # This ends the line started by httpCopyProgress
    puts ""
        flush stdout

    upvar #0 $token state
        array set headers $state(meta)
        #parray headers
        if {[info exists headers(location) ]} {
                set headers(Location) $headers(location)
        } 
    if {[info exists headers(Location) ] } {
                # Handle URL redirects
                puts "redirecting" 
                return [httpcopy [string trim $headers(Location)] $file $chunk]
        }
    if { [string first "text/html" $headers(Content-Type) ] >= 0 } {  
        set fd [open $file r ]
        set buffer [ read $fd ]
        close $fd
        set idx [string first {<meta http-equiv="refresh"} $buffer ]
        if { $idx >= 0 } { 
           set endidx [string first {>} $buffer $idx+1 ]
           set line [string range $buffer $idx $endidx ]
           if { [regexp {url=([^\"]+)\"} $line match url ] } {
              return [httpcopy $url $file $chunk ]
           } else {
              puts "no refresh url found"
           } 
        } else {
          puts "no refresh url found"
        } 
    }
    return $token
}

proc httpCopyProgress { token total current } {
    set percentage "\b\b\b0%" 
    if { $total > 0 } {
        set percentage [expr { 100 * (( $current * 1.0 )/( $total * 1.0 )) } ]
        set percentage [format "\b\b\b\b\b\b\b% 3.1f%%" $percentage ]
    }
    puts  -nonewline stdout "$percentage"
    flush stdout
}
set filename tcl8.7a5-src.tar.gz
set token [ httpcopy https://sourceforge.net/projects/tcl/files/Tcl/8.7a5/$filename $filename ]
http::wait $token
puts "$filename :  [file size $filename ]"

Example Output

httpcopy : getting https://sourceforge.net/projects/tcl/files/Tcl/8.7a5/tcl8.7a5-src.tar.gz -> tcl8.7a5-src.tar.gz 
 100.0%
redirecting
httpcopy : getting https://sourceforge.net/projects/tcl/files/Tcl/8.7a5/tcl8.7a5-src.tar.gz/ -> tcl8.7a5-src.tar.gz 
 100.0%
redirecting
httpcopy : getting https://sourceforge.net/projects/tcl/files/Tcl/8.7a5/tcl8.7a5-src.tar.gz/download -> tcl8.7a5-src.tar.gz 
0%
httpcopy : getting https://downloads.sourceforge.net/project/tcl/Tcl/8.7a5/tcl8.7a5-src.tar.gz?ts=gAAAAABg50q7aQTACKFhfeKNY6FN8YkXifLHF31Pg1PF5ezz85dxC2jHDII22HpunM0eubqzZ6sCPR4lxde9fuVsmOFkAkeKCQ%3D%3D&amp;use_mirror=iweb&amp;r= -> tcl8.7a5-src.tar.gz 
 100.0%
redirecting
httpcopy : getting https://iweb.dl.sourceforge.net/project/tcl/Tcl/8.7a5/tcl8.7a5-src.tar.gz -> tcl8.7a5-src.tar.gz 
 100.0%
tcl8.7a5-src.tar.gz :  6362958