Tcl Library Source Code

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

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

Overview
Comment:Cleanup module uri. There is a large amount of unused code that obfuscates the useful code and deters revision. * Remove non-executed code and unused variables. ** Many regexps were defined but never used. ** Some regexps were even demanded and carefully processed by uri::register, but then never used. ** The function ::uri::GetHostPort was never used. * Deprecate uri::register. ** Registration is of little value: the schemes gopher, wais and prospero, although registered, have no functionality because the corresponding split and join commands are not defined. ** Leave the uri::register function in place for use by third-party code.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 436d5be89bab18ef8ca34d187541d9839d9a626f
User & Date: kjnash 2017-01-07 01:20:14
Context
2017-01-07
15:39
Module uri. In order to preserve backward compatibility, reverse many of the changes made in the previous commit. The module has a secondary role as a repository of useful regexp patterns, which are not entirely documented. Rearrange pattern definitions in an attempt to segregate the code for the two different roles. Undo deprecation of uri::register. Add comments to explain the purpose of each block of definitions. check-in: 6c65571dfa user: kjnash tags: trunk
01:20
Cleanup module uri. There is a large amount of unused code that obfuscates the useful code and deters revision. * Remove non-executed code and unused variables. ** Many regexps were defined but never used. ** Some regexps were even demanded and carefully processed by uri::register, but then never used. ** The function ::uri::GetHostPort was never used. * Deprecate uri::register. ** Registration is of little value: the schemes gopher, wais and prospero, although registered, have no functionality because the corresponding split and join commands are not defined. ** Leave the uri::register function in place for use by third-party code. check-in: 436d5be89b user: kjnash tags: trunk
2017-01-03
17:58
Module uri - Modify uri::join to supply user:pwd, and to avoid confusing host and path in the file scheme; uri::resolve to avoid transferring user:pwd and port from one origin to another, to canonicalize when required by the RFC, and to handle fragment correctly; and uri::split to fix a bug when a relative uri begins with "//". Add tests for these and earlier fixes. check-in: e3bf643c52 user: kjnash tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/uri/uri.tcl. 

1
2
3
4
5
6
7

8
9
10
11
12
13
14

# uri.tcl --
#
#	URI parsing and fetch
#
# Copyright (c) 2000 Zveno Pty Ltd
# Copyright (c) 2006 Pierre DAVID <[email protected]>
# Copyright (c) 2006 Andreas Kupries <[email protected]>

# Steve Ball, http://www.zveno.com/
# Derived from urls.tcl by Andreas Kupries
#
# TODO:
#	Handle www-url-encoding details
#
# CVS: $Id: uri.tcl,v 1.36 2011/03/23 04:39:54 andreas_kupries Exp $








>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

# uri.tcl --
#
#	URI parsing and fetch
#
# Copyright (c) 2000 Zveno Pty Ltd
# Copyright (c) 2006 Pierre DAVID <[email protected]>
# Copyright (c) 2006 Andreas Kupries <[email protected]>
# Copyright (c) 2017 Keith Nash <[email protected]>
# Steve Ball, http://www.zveno.com/
# Derived from urls.tcl by Andreas Kupries
#
# TODO:
#	Handle www-url-encoding details
#
# CVS: $Id: uri.tcl,v 1.36 2011/03/23 04:39:54 andreas_kupries Exp $
︙︙
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98

99

100

101


102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157

    namespace export canonicalize
    namespace export register

    variable file:counter 0

    # extend these variable in the coming namespaces
    variable schemes       {}
    variable schemePattern ""
    variable url           ""
    variable url2part
    array set url2part     {}

    # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    # basic regular expressions used in URL syntax.

    namespace eval basic {
	variable	loAlpha		{[a-z]}
	variable	hiAlpha		{[A-Z]}
	variable	digit		{[0-9]}
	variable	alpha		{[a-zA-Z]}
	variable	safe		{[$_.+-]}
	variable	extra		{[!*'(,)]}
	# danger in next pattern, order important for []
	variable	national	{[][|\}\{\^~`]}
	variable	punctuation	{[<>#%"]}	;#" fake emacs hilit
	variable	reserved	{[;/?:@&=]}
	variable	hex		{[0-9A-Fa-f]}
	variable	alphaDigit	{[A-Za-z0-9]}
	variable	alphaDigitMinus	{[A-Za-z0-9-]}

	# next is <national | punctuation>
	variable	unsafe		{[][<>"#%\{\}|\\^~`]} ;#" emacs hilit
	variable	escape		"%${hex}${hex}"

	#	unreserved	= alpha | digit | safe | extra
	#	xchar		= unreserved | reserved | escape

	variable	unreserved	{[a-zA-Z0-9$_.+!*'(,)-]}
	variable	uChar		"(${unreserved}|${escape})"
	variable	xCharN		{[a-zA-Z0-9$_.+!*'(,);/?:@&=-]}
	variable	xChar		"(${xCharN}|${escape})"
	variable	digits		"${digit}+"

	variable	toplabel	\
		"(${alphaDigit}${alphaDigitMinus}*${alphaDigit}\\.?|${alphaDigit}\\.?)"
	variable	domainlabel	\
		"(${alphaDigit}${alphaDigitMinus}*${alphaDigit}|${alphaDigit})"

	variable	hostname	\
		"((${domainlabel}\\.)*${toplabel})"
	variable	hostnumber4	\
		"(?:${digits}\\.${digits}\\.${digits}\\.${digits})"
	variable	hostnumber6	{(?:\[[^]]*\])}
 	variable	hostnumber	"(${hostnumber4}|${hostnumber6})"

	variable	host		"(${hostname}|${hostnumber})"

	variable	port		$digits
	variable	hostOrPort	"${host}(:${port})?"

	variable	usrCharN	{[a-zA-Z0-9$_.+!*'(,);?&=-]}
	variable	usrChar		"(${usrCharN}|${escape})"
	variable	user		"${usrChar}*"
	variable	password	$user
	variable	login		"(${user}(:${password})?@)?${hostOrPort}"
    } ;# basic {}
}

# ::uri::register --
#
#	Register a scheme (and aliases) in the package. The command
#	creates a namespace below "::uri" with the same name as the
#	scheme and executes the script declaring the pattern variables
#	for this scheme in the new namespace. At last it updates the
#	uri variables keeping track of overall scheme information.
#

#	The script has to declare at least the variable "schemepart",

#	the pattern for an url of the registered scheme after the

#	scheme declaration. Not declaring this variable is an error.


#
# Arguments:
#	schemeList	Name of the scheme to register, plus aliases
#       script		Script declaring the scheme patterns
#
# Results:
#	None.

proc ::uri::register {schemeList script} {
    variable schemes
    variable schemePattern
    variable url
    variable url2part

    # Check scheme and its aliases for existence.
    foreach scheme $schemeList {
	if {[lsearch -exact $schemes $scheme] >= 0} {
	    return -code error \
		    "trying to register scheme (\"$scheme\") which is already known"
	}
    }

    # Get the main scheme
    set scheme  [lindex $schemeList 0]

    if {[catch {namespace eval $scheme $script} msg]} {
	catch {namespace delete $scheme}
	return -code error \
	    "error while evaluating scheme script: $msg"
    }

    if {![info exists ${scheme}::schemepart]} {
	namespace delete $scheme
	return -code error \
	    "Variable \"schemepart\" is missing."
    }

    # Now we can extend the variables which keep track of the registered schemes.

    eval [linsert $schemeList 0 lappend schemes]
    set schemePattern	"([::join $schemes |]):"

    foreach s $schemeList {
	# FRINK: nocheck
	set url2part($s) "${s}:[set ${scheme}::schemepart]"
	# FRINK: nocheck
	append url "(${s}:[set ${scheme}::schemepart])|"
    }
    set url [string trimright $url |]
    return
}

# ::uri::split --
#
#	Splits the given <a url> into its constituents.
#








<
<
<
<





<
<

<
<
<
<
<
<
<



<
<
<

<
<
<
<
<
<
<
<












|
<
|


<





|



|




|
<

>
|
>
|
>
|
>
>










<
<
<

















<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<








24
25
26
27
28
29
30




31
32
33
34
35


36







37
38
39



40








41
42
43
44
45
46
47
48
49
50
51
52
53

54
55
56

57
58
59
60
61
62
63
64
65
66
67
68
69
70
71

72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90



91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107



















108
109
110
111
112
113
114

    namespace export canonicalize
    namespace export register

    variable file:counter 0

    # extend these variable in the coming namespaces
    variable schemes       {}





    # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    # basic regular expressions used in URL syntax.

    namespace eval basic {


	variable	digit		{[0-9]}







	variable	hex		{[0-9A-Fa-f]}
	variable	alphaDigit	{[A-Za-z0-9]}
	variable	alphaDigitMinus	{[A-Za-z0-9-]}



	variable	escape		"%${hex}${hex}"








	variable	digits		"${digit}+"

	variable	toplabel	\
		"(${alphaDigit}${alphaDigitMinus}*${alphaDigit}\\.?|${alphaDigit}\\.?)"
	variable	domainlabel	\
		"(${alphaDigit}${alphaDigitMinus}*${alphaDigit}|${alphaDigit})"

	variable	hostname	\
		"((${domainlabel}\\.)*${toplabel})"
	variable	hostnumber4	\
		"(?:${digits}\\.${digits}\\.${digits}\\.${digits})"
	variable	hostnumber6	{(?:\[[^]]*\])}
	variable	hostnumber	"(${hostnumber4}|${hostnumber6})"

	variable	hostspec	"${hostname}|${hostnumber}"

	variable	port		$digits


	variable	usrCharN	{[a-zA-Z0-9$_.+!*'(,);?&=-]}
	variable	usrChar		"(${usrCharN}|${escape})"
	variable	user		"${usrChar}*"
	variable	password	$user
	# Used by commands: hostspec port user password
    } ;# basic {}
}

# ::uri::register (DEPRECATED) --
#
#	Register a scheme (and aliases) in the package. The command
#	creates a namespace below "::uri" with the same name as the
#	scheme and executes the script declaring the pattern variables
#	for this scheme in the new namespace.

#
# REASON FOR DEPRECATION
#	- Registration defines a namespace and pattern variables.
#	- From v1.2.7, the built-in schemes (and the urn scheme) do this without
#	  calling uri::register.
#	- Before v1.2.7, uri::register prevented re-registration of the same
#	  scheme name(s), and maintained variables that were not used for
#	  anything.
#	- The command is retained for use by third-party legacy code.
#
# Arguments:
#	schemeList	Name of the scheme to register, plus aliases
#       script		Script declaring the scheme patterns
#
# Results:
#	None.

proc ::uri::register {schemeList script} {
    variable schemes




    # Check scheme and its aliases for existence.
    foreach scheme $schemeList {
	if {[lsearch -exact $schemes $scheme] >= 0} {
	    return -code error \
		    "trying to register scheme (\"$scheme\") which is already known"
	}
    }

    # Get the main scheme
    set scheme  [lindex $schemeList 0]

    if {[catch {namespace eval $scheme $script} msg]} {
	catch {namespace delete $scheme}
	return -code error \
	    "error while evaluating scheme script: $msg"
    }



















    return
}

# ::uri::split --
#
#	Splits the given <a url> into its constituents.
#
︙︙
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304

    #
    #   Within the <path> and <searchpart> components, "/", ";", "?" are
    #   reserved.  The "/" character may be used within HTTP to designate a
    #   hierarchical structure.
    #
    # path == <cwd1> "/" ..."/" <cwdN> "/" <name> ["#" <fragment>]

    upvar #0 [namespace current]::http::search  search
    upvar #0 [namespace current]::http::segment segment

    array set parts {host {} port {} path {} query {} fragment {}}

    set searchPattern   "\\?(${search})\$"
    set fragmentPattern "#(.*)\$"

    # slash off possible fragment.

    # NOTE: This must be done before the query, because a fragment can
    # follow a query, and slashing off the query first will take the
    # fragment with it. Bug #3235340.








<
<
<


<








242
243
244
245
246
247
248



249
250

251
252
253
254
255
256
257

    #
    #   Within the <path> and <searchpart> components, "/", ";", "?" are
    #   reserved.  The "/" character may be used within HTTP to designate a
    #   hierarchical structure.
    #
    # path == <cwd1> "/" ..."/" <cwdN> "/" <name> ["#" <fragment>]




    array set parts {host {} port {} path {} query {} fragment {}}


    set fragmentPattern "#(.*)\$"

    # slash off possible fragment.

    # NOTE: This must be done before the query, because a fragment can
    # follow a query, and slashing off the query first will take the
    # fragment with it. Bug #3235340.
︙︙
367
368
369
370
371
372
373
374
375
376
377
378
379
380

381
382
383
384
385
386
387

}

proc ::uri::SplitFile {url} {
    # @c Splits the given file-<a url> into its constituents.
    # @a url: The url to split, without! scheme specification.
    # @r List containing the constituents, suitable for 'array set'.

    upvar #0 [namespace current]::basic::hostname	hostname
    upvar #0 [namespace current]::basic::hostnumber	hostnumber

    if {[string match "//*" $url]} {
	set url [string range $url 2 end]

	set hostPattern "^($hostname|$hostnumber)"

	switch -exact -- $::tcl_platform(platform) {
	    windows {
		# Catch drive letter
		append hostPattern :?
	    }
	    default {
		# Proceed as usual








|
<




|
>








320
321
322
323
324
325
326
327

328
329
330
331
332
333
334
335
336
337
338
339
340

}

proc ::uri::SplitFile {url} {
    # @c Splits the given file-<a url> into its constituents.
    # @a url: The url to split, without! scheme specification.
    # @r List containing the constituents, suitable for 'array set'.

    upvar #0 [namespace current]::basic::hostspec	hostspec


    if {[string match "//*" $url]} {
	set url [string range $url 2 end]

	set hostPattern "^($hostspec)"

	switch -exact -- $::tcl_platform(platform) {
	    windows {
		# Catch drive letter
		append hostPattern :?
	    }
	    default {
		# Proceed as usual
︙︙
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584

    # @d Side effect: The extracted information is removed from the given url.
    # @r List containing the extracted information in a format suitable for
    # @r 'array set'.
    # @a urlvar: Name of the variable containing the url to parse.

    upvar \#0 [namespace current]::basic::user		user
    upvar \#0 [namespace current]::basic::password	password
    upvar \#0 [namespace current]::basic::hostname	hostname
    upvar \#0 [namespace current]::basic::hostnumber	hostnumber
    upvar \#0 [namespace current]::basic::port		port

    upvar $urlvar url
    set url_save $url

    array set parts {user {} pwd {} host {} port {}}









|
<








522
523
524
525
526
527
528
529

530
531
532
533
534
535
536

    # @d Side effect: The extracted information is removed from the given url.
    # @r List containing the extracted information in a format suitable for
    # @r 'array set'.
    # @a urlvar: Name of the variable containing the url to parse.

    upvar \#0 [namespace current]::basic::user		user
    upvar \#0 [namespace current]::basic::password	password
    upvar \#0 [namespace current]::basic::hostspec	hostspec

    upvar \#0 [namespace current]::basic::port		port

    upvar $urlvar url
    set url_save $url

    array set parts {user {} pwd {} host {} port {}}
︙︙
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614


	set  matchEnd   [lindex $match 1]
	incr matchEnd

	set url	[string range $url $matchEnd end]
    }

    set hpPattern "^($hostname|$hostnumber)(:($port))?"

    if {[regexp -indices -- $hpPattern $url match theHost c d e f g h thePort]} {
	set fh	[lindex $theHost 0]
	set th	[lindex $theHost 1]

	set fp	[lindex $thePort 0]
	set tp	[lindex $thePort 1]








|








552
553
554
555
556
557
558
559
560
561
562
563
564
565
566


	set  matchEnd   [lindex $match 1]
	incr matchEnd

	set url	[string range $url $matchEnd end]
    }

    set hpPattern "^($hostspec)(:($port))?"

    if {[regexp -indices -- $hpPattern $url match theHost c d e f g h thePort]} {
	set fh	[lindex $theHost 0]
	set th	[lindex $theHost 1]

	set fp	[lindex $thePort 0]
	set tp	[lindex $thePort 1]
︙︙
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669

	set url	[string range $url $matchEnd end]
    }
    
    if {![string match /* $url] && $url ne {}} {
	error [list {invalid url} $url $url_save]
    }

    return [array get parts]
}

proc ::uri::GetHostPort {urlvar} {
    # @c Parse host and port out of the url stored in variable <a urlvar>.
    # @d Side effect: The extracted information is removed from the given url.
    # @r List containing the extracted information in a format suitable for
    # @r 'array set'.
    # @a urlvar: Name of the variable containing the url to parse.

    upvar #0 [namespace current]::basic::hostname	hostname
    upvar #0 [namespace current]::basic::hostnumber	hostnumber
    upvar #0 [namespace current]::basic::port		port

    upvar $urlvar url

    set pattern "^(${hostname}|${hostnumber})(:(${port}))?"

    if {[regexp -indices -- $pattern $url match host c d e f g h thePort]} {
	set fromHost	[lindex $host 0]
	set toHost	[lindex $host 1]

	set fromPort	[lindex $thePort 0]
	set toPort	[lindex $thePort 1]

	set parts(host)	[string range $url $fromHost $toHost]
	set parts(port)	[string range $url $fromPort $toPort]

	set  matchEnd   [lindex $match 1]
	incr matchEnd

	set url [string range $url $matchEnd end]
    }

    return [array get parts]
}

# ::uri::resolve --
#
#	Resolve an arbitrary URL, given a base URL
#








<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<








574
575
576
577
578
579
580


































581
582
583
584
585
586
587

	set url	[string range $url $matchEnd end]
    }
    
    if {![string match /* $url] && $url ne {}} {
	error [list {invalid url} $url $url_save]
    }



































    return [array get parts]
}

# ::uri::resolve --
#
#	Resolve an arbitrary URL, given a base URL
#
︙︙
983
984
985
986
987
988
989

990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173

# Currently known URL schemes:
#
# (RFC 1738)
# ------------------------------------------------
# scheme	basic syntax of scheme specific part
# ------------------------------------------------
# ftp		//<user>:<password>@<host>:<port>/<cwd1>/.../<cwdN>/<name>;type=<typecode>

#
# http		//<host>:<port>/<path>?<searchpart>
#
# gopher	//<host>:<port>/<gophertype><selector>
#				<gophertype><selector>%09<search>
#		<gophertype><selector>%09<search>%09<gopher+_string>
#
# mailto	<rfc822-addr-spec>
# news		<newsgroup-name>
#		<message-id>
# nntp		//<host>:<port>/<newsgroup-name>/<article-number>
# telnet	//<user>:<password>@<host>:<port>/
# wais		//<host>:<port>/<database>
#		//<host>:<port>/<database>?<search>
#		//<host>:<port>/<database>/<wtype>/<wpath>
# file		//<host>/<path>
# prospero	//<host>:<port>/<hsoname>;<field>=<value>
# ------------------------------------------------
#
# (RFC 2111)
# ------------------------------------------------
# scheme	basic syntax of scheme specific part
# ------------------------------------------------
# mid	message-id
#		message-id/content-id
# cid	content-id
# ------------------------------------------------
#
# (RFC 2255)
# ------------------------------------------------
# scheme	basic syntax of scheme specific part
# ------------------------------------------------
# ldap		//<host>:<port>/<dn>?<attrs>?<scope>?<filter>?<extensions>
# ------------------------------------------------

# FTP
uri::register ftp {
    variable escape [set [namespace parent [namespace current]]::basic::escape]
    variable login  [set [namespace parent [namespace current]]::basic::login]

    variable	charN	{[a-zA-Z0-9$_.+!*'(,)?:@&=-]}
    variable	char	"(${charN}|${escape})"
    variable	segment	"${char}*"
    variable	path	"${segment}(/${segment})*"

    variable	type		{[AaDdIi]}
    variable	typepart	";type=(${type})"
    variable	schemepart	\
		    "//${login}(/${path}(${typepart})?)?"

    variable	url		"ftp:${schemepart}"
}

# FILE
uri::register file {
    variable	host [set [namespace parent [namespace current]]::basic::host]
    variable	path [set [namespace parent [namespace current]]::ftp::path]

    variable	schemepart	"//(${host}|localhost)?/${path}"
    variable	url		"file:${schemepart}"
}

# HTTP
uri::register http {
    variable	escape \
        [set [namespace parent [namespace current]]::basic::escape]
    variable	hostOrPort	\
        [set [namespace parent [namespace current]]::basic::hostOrPort]

    variable	charN		{[a-zA-Z0-9$_.+!*'(,);:@&=-]}
    variable	char		"($charN|${escape})"
    variable	segment		"${char}*"

    variable	path		"${segment}(/${segment})*"
    variable	search		$segment
    variable	schemepart	\
	    "//${hostOrPort}(/${path}(\\?${search})?)?"

    variable	url		"http:${schemepart}"
}

# GOPHER
uri::register gopher {
    variable	xChar \
        [set [namespace parent [namespace current]]::basic::xChar]
    variable	hostOrPort \
        [set [namespace parent [namespace current]]::basic::hostOrPort]
    variable	search \
        [set [namespace parent [namespace current]]::http::search]

    variable	type		$xChar
    variable	selector	"$xChar*"
    variable	string		$selector
    variable	schemepart	\
	    "//${hostOrPort}(/(${type}(${selector}(%09${search}(%09${string})?)?)?)?)?"
    variable	url		"gopher:${schemepart}"
}

# MAILTO
uri::register mailto {
    variable xChar [set [namespace parent [namespace current]]::basic::xChar]
    variable host  [set [namespace parent [namespace current]]::basic::host]

    variable schemepart	"$xChar+(@${host})?"
    variable url	"mailto:${schemepart}"
}

# NEWS
uri::register news {
    variable escape [set [namespace parent [namespace current]]::basic::escape]
    variable alpha  [set [namespace parent [namespace current]]::basic::alpha]
    variable host   [set [namespace parent [namespace current]]::basic::host]

    variable	aCharN		{[a-zA-Z0-9$_.+!*'(,);/?:&=-]}
    variable	aChar		"($aCharN|${escape})"
    variable	gChar		{[a-zA-Z0-9$_.+-]}
    variable	newsgroup-name	"${alpha}${gChar}*"
    variable	message-id	"${aChar}+@${host}"
    variable	schemepart	"\\*|${newsgroup-name}|${message-id}"
    variable	url		"news:${schemepart}"
}

# WAIS
uri::register wais {
    variable	uChar \
        [set [namespace parent [namespace current]]::basic::xChar]
    variable	hostOrPort \
        [set [namespace parent [namespace current]]::basic::hostOrPort]
    variable	search \
        [set [namespace parent [namespace current]]::http::search]

    variable	db		"${uChar}*"
    variable	type		"${uChar}*"
    variable	path		"${uChar}*"

    variable	database	"//${hostOrPort}/${db}"
    variable	index		"//${hostOrPort}/${db}\\?${search}"
    variable	doc		"//${hostOrPort}/${db}/${type}/${path}"

    #variable	schemepart	"${doc}|${index}|${database}"

    variable	schemepart \
	    "//${hostOrPort}/${db}((\\?${search})|(/${type}/${path}))?"

    variable	url		"wais:${schemepart}"
}

# PROSPERO
uri::register prospero {
    variable	escape \
        [set [namespace parent [namespace current]]::basic::escape]
    variable	hostOrPort \
        [set [namespace parent [namespace current]]::basic::hostOrPort]
    variable	path \
        [set [namespace parent [namespace current]]::ftp::path]

    variable	charN		{[a-zA-Z0-9$_.+!*'(,)?:@&-]}
    variable	char		"(${charN}|$escape)"

    variable	fieldname	"${char}*"
    variable	fieldvalue	"${char}*"
    variable	fieldspec	";${fieldname}=${fieldvalue}"

    variable	schemepart	"//${hostOrPort}/${path}(${fieldspec})*"
    variable	url		"prospero:$schemepart"
}

# LDAP
uri::register ldap {
    variable	hostOrPort \
        [set [namespace parent [namespace current]]::basic::hostOrPort]

    # very crude parsing
    variable	dn		{[^?]*}
    variable	attrs		{[^?]*}
    variable	scope		"base|one|sub"
    variable	filter		{[^?]*}
    # extensions are not handled yet

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

package provide uri 1.2.7








>

|













|




















<
<
<
|
<
<
<
<
<
|
|
<
<
|
<


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944



945





946
947


948

949
950


































































































































951

# Currently known URL schemes:
#
# (RFC 1738)
# ------------------------------------------------
# scheme	basic syntax of scheme specific part
# ------------------------------------------------
# ftp		//<user>:<password>@<host>:<port>/<cwd1>/.../<cwdN>/<name>;type=<typecode>
#    		//<user>:<password>@<host>:<port>/fpath;type=<typecode>
#
# http		//<host>:<port>/<hpath>?<searchpart>
#
# gopher	//<host>:<port>/<gophertype><selector>
#				<gophertype><selector>%09<search>
#		<gophertype><selector>%09<search>%09<gopher+_string>
#
# mailto	<rfc822-addr-spec>
# news		<newsgroup-name>
#		<message-id>
# nntp		//<host>:<port>/<newsgroup-name>/<article-number>
# telnet	//<user>:<password>@<host>:<port>/
# wais		//<host>:<port>/<database>
#		//<host>:<port>/<database>?<search>
#		//<host>:<port>/<database>/<wtype>/<wpath>
# file		//<host>/<fpath>
# prospero	//<host>:<port>/<hsoname>;<field>=<value>
# ------------------------------------------------
#
# (RFC 2111)
# ------------------------------------------------
# scheme	basic syntax of scheme specific part
# ------------------------------------------------
# mid	message-id
#		message-id/content-id
# cid	content-id
# ------------------------------------------------
#
# (RFC 2255)
# ------------------------------------------------
# scheme	basic syntax of scheme specific part
# ------------------------------------------------
# ldap		//<host>:<port>/<dn>?<attrs>?<scope>?<filter>?<extensions>
# ------------------------------------------------

# FTP



namespace eval ::uri::ftp {





    variable	Type		{[AaDdIi]}
    variable	typepart	";type=(${Type})"


    # Used elsewhere: typepart

}



































































































































package provide uri 1.2.7

Changes to modules/uri/urn-scheme.tcl.

︙︙
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140

        # Recode the array of utf-8 bytes to the proper internal rep.
        return [encoding convertfrom utf-8 $result]
    }
}

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

::uri::register {urn URN} {
	variable NIDpart {[a-zA-Z0-9][a-zA-Z0-9-]{0,31}}
        variable esc {%[0-9a-fA-F]{2}}
        variable trans {a-zA-Z0-9$_.+!*'(,):=@;-}
        variable NSSpart "($esc|\[$trans\])+"
        variable URNpart "($NIDpart):($NSSpart)"
        variable schemepart $URNpart
	variable url "urn:$NIDpart:$NSSpart"
}

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

package provide uri::urn 1.0.3

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








|





<
|








119
120
121
122
123
124
125
126
127
128
129
130
131

132
133
134
135
136
137
138
139

        # Recode the array of utf-8 bytes to the proper internal rep.
        return [encoding convertfrom utf-8 $result]
    }
}

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

namespace eval ::uri::urn {
	variable NIDpart {[a-zA-Z0-9][a-zA-Z0-9-]{0,31}}
        variable esc {%[0-9a-fA-F]{2}}
        variable trans {a-zA-Z0-9$_.+!*'(,):=@;-}
        variable NSSpart "($esc|\[$trans\])+"
        variable URNpart "($NIDpart):($NSSpart)"

        # Used elsewhere: NIDpart trans URNpart
}

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

package provide uri::urn 1.0.3

# -------------------------------------------------------------------------
︙︙

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