Tcl Library Source Code

Check-in [a29e0299a8]
Login
Core Home Blog Docs Downloads Tickets Timeline Branches Tags Wiki

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:uri - Ticket [c315712173] - Fixed handling of scheme-relative urls which have an authority (network-path). New test cases. Version bumped to 1.2.5.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: a29e0299a8be244e77305d6dea98945ac9a27522
User & Date: andreask 2015-04-15 19:48:49
References
2015-04-15
19:49 • Closed ticket [c315712173]: uri::resolve doesn't handle scheme-relative urls plus 6 other changes artifact: 01d743a9f9 user: aku
Context
2015-04-15
20:59
ip - Ticket [510c9fce1b] - Added distance and nextIp commands provided by Martin Heinrich. Extended testsuite, docs. Version bumped to 1.3. check-in: e2be9b2f86 user: andreask tags: trunk
19:48
uri - Ticket [c315712173] - Fixed handling of scheme-relative urls which have an authority (network-path). New test cases. Version bumped to 1.2.5. check-in: a29e0299a8 user: andreask tags: trunk
19:12
dns - Ticket [7e0f5ae0f6] - Fixed the missing automatic wait on replies in udp mode without a -command forcing async operation. To this end the responsible code has been moved out of the TCP branch where it lived since udp support was added in 2003. check-in: ca36641e9f user: andreask tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/uri/pkgIndex.tcl. 

1
2
3
4
5
6

if {![package vsatisfies [package provide Tcl] 8.2]} {
    # FRINK: nocheck
    return
}
package ifneeded uri      1.2.4 [list source [file join $dir uri.tcl]]
package ifneeded uri::urn 1.0.3 [list source [file join $dir urn-scheme.tcl]]





|


1
2
3
4
5
6

if {![package vsatisfies [package provide Tcl] 8.2]} {
    # FRINK: nocheck
    return
}
package ifneeded uri      1.2.5 [list source [file join $dir uri.tcl]]
package ifneeded uri::urn 1.0.3 [list source [file join $dir urn-scheme.tcl]]

Changes to modules/uri/uri.man. 


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28


[manpage_begin uri n 1.2.4]
[keywords {fetching information}]
[keywords file]
[keywords ftp]
[keywords gopher]
[keywords http]
[keywords ldap]
[keywords mailto]
[keywords news]
[keywords prospero]
[keywords {rfc 2255}]
[keywords {rfc 2396}]
[keywords uri]
[keywords url]
[keywords wais]
[keywords www]
[moddesc   {Tcl Uniform Resource Identifier Management}]
[titledesc {URI utilities}]
[category  Networking]
[require Tcl 8.2]
[require uri [opt 1.2.4]]
[description]

This package contains two parts. First it provides regular expressions
for a number of url/uri schemes. Second it provides a number of
commands for manipulating urls/uris and fetching data specified by
them. For the latter this package analyses the requested url/uri and
then dispatches it to the appropriate package (http, ftp, ...) for

>
|



















|








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

[vset VERSION 1.2.5]
[manpage_begin uri n [vset VERSION]]
[keywords {fetching information}]
[keywords file]
[keywords ftp]
[keywords gopher]
[keywords http]
[keywords ldap]
[keywords mailto]
[keywords news]
[keywords prospero]
[keywords {rfc 2255}]
[keywords {rfc 2396}]
[keywords uri]
[keywords url]
[keywords wais]
[keywords www]
[moddesc   {Tcl Uniform Resource Identifier Management}]
[titledesc {URI utilities}]
[category  Networking]
[require Tcl 8.2]
[require uri [opt [vset VERSION]]]
[description]

This package contains two parts. First it provides regular expressions
for a number of url/uri schemes. Second it provides a number of
commands for manipulating urls/uris and fetching data specified by
them. For the latter this package analyses the requested url/uri and
then dispatches it to the appropriate package (http, ftp, ...) for
︙︙

Changes to modules/uri/uri.tcl.

︙︙
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668






669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692

#
# Results:
#	Returns a URL

proc ::uri::resolve {base url} {
    if {[string length $url]} {
	if {[isrelative $url]} {

	    array set baseparts [split $base]

	    switch -- $baseparts(scheme) {
		http -
		https -
		ftp -
		file {
		    array set relparts [split $baseparts(scheme):$url]
		    if { [string match /* $url] } {
			catch { set baseparts(path) $relparts(path) }






		    } elseif { [string match */ $baseparts(path)] } {
			set baseparts(path) "$baseparts(path)$relparts(path)"
		    } else {
			if { [string length $relparts(path)] > 0 } {
			    set path [lreplace [::split $baseparts(path) /] end end]
			    set baseparts(path) "[::join $path /]/$relparts(path)"
			}
		    }
		    catch { set baseparts(query) $relparts(query) }
		    catch { set baseparts(fragment) $relparts(fragment) }
		    return [eval [linsert [array get baseparts] 0 join]]
		}
		default {
		    return -code error "unable to resolve relative URL \"$url\""
		}
	    }

	} else {
	    return $url
	}
    } else {
	return $base
    }
}








<










>
>
>
>
>
>
















<








651
652
653
654
655
656
657

658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689

690
691
692
693
694
695
696

#
# Results:
#	Returns a URL

proc ::uri::resolve {base url} {
    if {[string length $url]} {
	if {[isrelative $url]} {

	    array set baseparts [split $base]

	    switch -- $baseparts(scheme) {
		http -
		https -
		ftp -
		file {
		    array set relparts [split $baseparts(scheme):$url]
		    if { [string match /* $url] } {
			catch { set baseparts(path) $relparts(path) }
			# RFC 3986 section 4.2 - no scheme, but authority (host), keep authority
			catch {
			    if {$relparts(host) != ""} {
				set baseparts(host) $relparts(host)
			    }
			}
		    } elseif { [string match */ $baseparts(path)] } {
			set baseparts(path) "$baseparts(path)$relparts(path)"
		    } else {
			if { [string length $relparts(path)] > 0 } {
			    set path [lreplace [::split $baseparts(path) /] end end]
			    set baseparts(path) "[::join $path /]/$relparts(path)"
			}
		    }
		    catch { set baseparts(query) $relparts(query) }
		    catch { set baseparts(fragment) $relparts(fragment) }
		    return [eval [linsert [array get baseparts] 0 join]]
		}
		default {
		    return -code error "unable to resolve relative URL \"$url\""
		}
	    }

	} else {
	    return $url
	}
    } else {
	return $base
    }
}
︙︙
1037
1038
1039
1040
1041
1042
1043
1044

    variable	filter		{[^?]*}
    # extensions are not handled yet

    variable	schemepart	"//${hostOrPort}(/${dn}(\?${attrs}(\?(${scope})(\?${filter})?)?)?)?"
    variable	url		"ldap:$schemepart"
}

package provide uri 1.2.4








|

1041
1042
1043
1044
1045
1046
1047
1048

    variable	filter		{[^?]*}
    # extensions are not handled yet

    variable	schemepart	"//${hostOrPort}(/${dn}(\?${attrs}(\?(${scope})(\?${filter})?)?)?)?"
    variable	url		"ldap:$schemepart"
}

package provide uri 1.2.5

Changes to modules/uri/uri.test.

︙︙
215
216
217
218
219
220
221













222
223
224
225
226
227
228

} http://www.example.com/?shoo=bee

test uri-3.10 {uri::resolve - two queries,
    one absolute URL, one absolute path} {
    uri::resolve http://www.example.com/baz?foo=bar /baz?shoo=bee
} http://www.example.com/baz?shoo=bee















# -------------------------------------------------------------------------

test uri-4.1 {uri::geturl} {
    set data [info commands]
    set file [makeFile {} __testdata]
    set f [open $file w]








>
>
>
>
>
>
>
>
>
>
>
>
>








215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241

} http://www.example.com/?shoo=bee

test uri-3.10 {uri::resolve - two queries,
    one absolute URL, one absolute path} {
    uri::resolve http://www.example.com/baz?foo=bar /baz?shoo=bee
} http://www.example.com/baz?shoo=bee


test uri-3.11 {uri::resolve - scheme-relative url with authority, rfc3986 4.2} {
    uri::resolve http://www.foo.com/ //www.bar.com/
}  http://www.bar.com/

test uri-3.12 {uri::resolve - scheme-relative url with authority, rfc3986 4.2} {
    uri::resolve https://www.foo.com/ //www.bar.com/
}  https://www.bar.com/

test uri-3.13 {uri::resolve - scheme-relative url with authority, rfc3986 4.2} {
    uri::resolve https://www.foo.com/ //www.bar.com
}  https://www.bar.com/


# -------------------------------------------------------------------------

test uri-4.1 {uri::geturl} {
    set data [info commands]
    set file [makeFile {} __testdata]
    set f [open $file w]
︙︙

This page was generated in about 0.017s by Fossil 2.24 [f4ffefe708] 2024-04-17 14:02:19