[66794] trunk/base/src/port1.0/fetch_common.tcl
jmr at macports.org
jmr at macports.org
Thu Apr 22 18:20:49 PDT 2010
Revision: 66794
http://trac.macports.org/changeset/66794
Author: jmr at macports.org
Date: 2010-04-22 18:20:48 -0700 (Thu, 22 Apr 2010)
Log Message:
-----------
percent-encode distfile string when assembling URLs (#18736)
Modified Paths:
--------------
trunk/base/src/port1.0/fetch_common.tcl
Modified: trunk/base/src/port1.0/fetch_common.tcl
===================================================================
--- trunk/base/src/port1.0/fetch_common.tcl 2010-04-23 01:19:06 UTC (rev 66793)
+++ trunk/base/src/port1.0/fetch_common.tcl 2010-04-23 01:20:48 UTC (rev 66794)
@@ -45,14 +45,40 @@
array set sites {}
}
+# percent-encode all characters in str that are not unreserved in URIs
+proc portfetch::percent_encode {str} {
+ set outstr ""
+ while {[string length $str] > 0} {
+ set char [string index $str 0]
+ set str [string range $str 1 end]
+ switch $char {
+ {-} -
+ {.} -
+ {_} -
+ {~} {
+ append outstr $char
+ }
+ default {
+ if {[string is ascii -strict $char] && [string is alnum -strict $char]} {
+ append outstr $char
+ } else {
+ foreach {a b} [split [format %02X [scan $char %c]] {}] {
+ append outstr "%${a}${b}"
+ }
+ }
+ }
+ }
+ }
+ return $outstr
+}
+
# Given a site url and the name of the distfile, assemble url and
# return it.
proc portfetch::assemble_url {site distfile} {
if {[string index $site end] != "/"} {
- return "${site}/${distfile}"
- } else {
- return "${site}${distfile}"
+ set site "${site}/"
}
+ return "${site}[percent_encode ${distfile}]"
}
# For a given mirror site type, e.g. "gnu" or "x11", check to see if there's a
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20100422/da148891/attachment.html>
More information about the macports-changes
mailing list