| ︙ | | |
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
|
16
17
18
19
20
21
22
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
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
|
#
# NOTE: Use our own namespace here because even though we do not directly
# support namespaces ourselves, we do not want to pollute the global
# namespace if this script actually ends up being evaluated in Tcl.
#
namespace eval ::PackageDownloader {
#
# NOTE: This procedure sets up the default values for all URN configuration
# parameters used by the package downloader client. If the force
# argument is non-zero, any existing values will be overwritten and
# set back to their default values.
#
proc setupDownloadUrnVars { force } {
#
# NOTE: The URN, relative to the base URI, where a login request may
# be sent.
#
variable loginUrn; # DEFAULT: pkgd_login
if {$force || ![info exists loginUrn]} then {
set loginUrn pkgd_login
}
#
# NOTE: The URN, relative to the base URI, where a single package file
# may be found.
#
variable downloadUrn; # DEFAULT: pkgd_file
if {$force || ![info exists downloadUrn]} then {
set downloadUrn pkgd_file
}
#
# NOTE: The URN, relative to the base URI, where a logout request may
# be sent.
#
variable logoutUrn; # DEFAULT: pkgd_logout
if {$force || ![info exists logoutUrn]} then {
set logoutUrn pkgd_logout
}
}
#
# NOTE: This procedure sets up the default values for all URI configuration
# parameters used by the package downloader client. If the force
# argument is non-zero, any existing values will be overwritten and
# set back to their default values.
#
proc setupDownloadUriVars { force } {
#
# NOTE: The base URI used to build the URIs for the package file server.
#
variable baseUri; # DEFAULT: https://urn.to/r
if {$force || ![info exists baseUri]} then {
set baseUri https://urn.to/r
}
#
# NOTE: The URI where a login request may be sent. This should return a
# payload containing the necessary HTTP(S) cookie information.
#
variable loginUri; # DEFAULT: ${baseUri}/${loginUrn}?...
if {$force || ![info exists loginUri]} then {
set loginUri [appendArgs \
{${baseUri}/${loginUrn}?} {[uriEscape name $userName]} & \
{[uriEscape password $password]}]
}
#
# NOTE: The URI where a single package file may be found. This file will
# belong to a specific version of one package.
#
variable downloadUri; # DEFAULT: ${baseUri}/${downloadUrn}?...
if {$force || ![info exists downloadUri]} then {
set downloadUri [appendArgs \
{${baseUri}/${downloadUrn}?download&ci=trunk&} \
{[uriEscape filename $fileName]}]
}
#
# NOTE: The URI where a logout request should be sent. This should
# return a payload indicating that the logout was successful.
#
variable logoutUri; # DEFAULT: ${baseUri}/${logoutUrn}?...
if {$force || ![info exists logoutUri]} then {
set logoutUri [appendArgs \
{${baseUri}/${logoutUrn}?} {[uriEscape authToken $authToken]}]
}
}
#
# NOTE: This procedure sets up the default values for all configuration
# parameters used by the package downloader client. There are no
# arguments.
# parameters used by the package downloader client. The script
# argument is the fully qualified path and file name for the script
# being evaluated.
#
proc setupDownloadVars { script } {
#
# NOTE: What is the fully qualified path to the directory containing the
# package downloader client?
#
variable clientDirectory
|
| ︙ | | |
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
|
143
144
145
146
147
148
149
150
151
152
153
154
155
156
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
|
#
variable quiet; # DEFAULT: true
if {![info exists quiet]} then {
set quiet true
}
#
# NOTE: The base URI used to build the URIs for the package file server.
#
variable baseUri; # DEFAULT: https://urn.to/r
if {![info exists baseUri]} then {
set baseUri https://urn.to/r
}
#
# NOTE: The URI where a login request may be sent. This should return a
# payload containing the necessary HTTP(S) cookie information.
#
variable loginUri; # DEFAULT: ${baseUri}/pkgd_login?...
if {![info exists loginUri]} then {
set loginUri [appendArgs \
{${baseUri}/pkgd_login?} {[uriEscape name $userName]} & \
{[uriEscape password $password]}]
}
#
# NOTE: The URI where a single package file may be found. This file will
# belong to a specific version of one package.
#
variable downloadUri; # DEFAULT: ${baseUri}/pkgd_file?...
if {![info exists downloadUri]} then {
set downloadUri [appendArgs \
{${baseUri}/pkgd_file?download&ci=trunk&} \
{[uriEscape filename $fileName]}]
}
#
# NOTE: The URI where the logout request should be sent. This should
# return a payload indicating that the logout was successful.
#
variable logoutUri; # DEFAULT: ${baseUri}/pkgd_logout?...
if {![info exists logoutUri]} then {
set logoutUri [appendArgs \
{${baseUri}/pkgd_logout?} {[uriEscape authToken $authToken]}]
}
|
| ︙ | | |
149
150
151
152
153
154
155
156
157
158
159
160
161
162
|
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
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
242
243
244
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
#
variable viaInstall; # DEFAULT: false
if {![info exists viaInstall]} then {
set viaInstall false
}
}
#
# NOTE: This procedure modifies the URN variables used by the package
# downloader client so that one or more alternative (private?)
# backend file servers may be used. The serverId argument must
# consist only of alphanumeric characters and it must begin with
# a letter.
#
# <public>
proc useServerId { {serverId ""} } {
variable downloadUrn
variable loginUrn
variable logoutUrn
if {[string length $serverId] > 0 && \
![regexp -nocase -- {^[A-Z][0-9A-Z]*$} $serverId]} then {
error "server Id must be alphanumeric and start with a letter"
}
if {[string length $serverId] > 0} then {
#
# NOTE: Set the URN variables to values that should cause the
# specified server Id to be used (assume the server Id
# itself is valid and active).
#
set loginUrn [appendArgs pkgd_login_ $serverId]
set downloadUrn [appendArgs pkgd_file_ $serverId]
set logoutUrn [appendArgs pkgd_logout_ $serverId]
} else {
#
# NOTE: Forcibly reset URN variables to their default values.
#
setupDownloadUrnVars true
}
}
#
# NOTE: This procedure escapes a single name/value pair for use in a URI
# query string. The name argument is the name of the parameter.
# The value argument is the value of the parameter.
#
proc uriEscape { name value } {
|
| ︙ | | |
652
653
654
655
656
657
658
659
660
661
662
663
664
665
|
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
|
+
|
# password that is associated with the specified user name.
#
# <public>
proc resetCookieAndLogin { userName password } {
variable baseUri
variable loginCookie
variable loginUri
variable loginUrn
#
# NOTE: Build the full URI for the login request.
#
set uri [subst $loginUri]
#
|
| ︙ | | |
702
703
704
705
706
707
708
709
710
711
712
713
714
715
|
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
|
+
|
# are no arguments. This procedure may raise a script error.
#
# <public>
proc logoutAndResetCookie {} {
variable baseUri
variable loginCookie
variable logoutUri
variable logoutUrn
#
# NOTE: Attempt to verify that we are currently logged in.
#
if {![info exists loginCookie] || [llength $loginCookie] != 2} then {
error "missing or invalid login cookie"
}
|
| ︙ | | |
820
821
822
823
824
825
826
827
828
829
830
831
832
833
|
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
|
+
|
# where the downloaded file should be written. The usePgp argument
# should be non-zero when an OpenPGP signature file needs to be
# downloaded and verified for the downloaded file.
#
proc downloadOneFile { language version fileName localFileName usePgp } {
variable baseUri
variable downloadUri
variable downloadUrn
#
# NOTE: First, build the full relative file name to download from
# the remote package repository.
#
set fileName [file join $language $version $fileName]
set uri [subst $downloadUri]
|
| ︙ | | |
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
|
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
|
+
+
+
+
+
+
|
::PackageRepository::maybeReadSettingsFile [info script]
#
# NOTE: Setup the variables, within this namespace, used by this script.
#
setupDownloadVars [info script]
#
# NOTE: Setup the URI and URN variables, within this namespace, used by
# this script.
#
setupDownloadUriVars false; setupDownloadUrnVars false
#
# NOTE: If necessary, add the package persistence root directory to the
# auto-path for the current language. This will only be done if
# it falls outside of the existing auto-path.
#
variable persistentRootDirectory
|
| ︙ | | |