105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
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
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
proc $procName $procArgs [appendArgs $procPreBody $procBody]
return [uplevel 1 [list $procName] $args]
}
}
#
# NOTE: This procedure sets up the default values for all URN configuration
# parameters used by the package repository client. If the force
# argument is non-zero, any existing values will be overwritten and
# set back to their default values.
#
proc setupRepositoryServerVars { force } {
#
# NOTE: The URN, relative to the base URI, where the package repository
# server may be contacted to lookup packages.
#
variable lookupUrn; # DEFAULT: pkgr_lookup
if {$force || ![info exists lookupUrn]} then {
set lookupUrn pkgr_lookup
}
#
# NOTE: The URN, relative to the base URI, where the package repository
# server may be contacted to submit packages.
#
variable submitUrn; # DEFAULT: pkgr_submit
if {$force || ![info exists submitUrn]} then {
set submitUrn pkgr_submit
}
}
#
# NOTE: This procedure sets up the default values for all URI configuration
# parameters used by the package repository client. If the force
# argument is non-zero, any existing values will be overwritten and
# set back to their default values.
#
proc setupRepositoryUriVars { 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 the package repository server may be contacted to
# lookup packages.
#
variable lookupUri; # DEFAULT: ${baseUri}/${lookupUrn}
if {$force || ![info exists lookupUri]} then {
set lookupUri {${baseUri}/${lookupUrn}}
}
#
# NOTE: The URI where the package repository server may be contacted to
# submit packages.
#
variable submitUri; # DEFAULT: ${baseUri}/${submitUrn}
if {$force || ![info exists submitUri]} then {
set submitUri {${baseUri}/${submitUrn}}
}
}
#
# NOTE: This procedure returns a string argument value, which may contain
# spaces, for use with the [exec] command. The value argument is
# the string value to format as an [exec] argument.
#
# <internal>
proc formatExecArgument { value } {
|
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
|
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
-
+
-
+
|
# NOTE: Otherwise, return the system default, which is "anonymous"
# packages only (i.e. those without any owners).
#
return [list]
}
#
# NOTE: This procedure verifies that the specified value is indeed a valid
# server identifier. The serverId argument is the value to verify.
# This procedure may raise script errors.
#
# <internal>
proc verifyServerId { serverId } {
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"
}
}
#
# NOTE: This procedure modifies the URN variables used by the package
# repository client so that one or more alternative (private?)
# backend repository 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 lookupUrn
variable submitUrn
verifyServerId $serverId
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 lookupUrn [appendArgs pkgr_lookup_ $serverId]
set submitUrn [appendArgs pkgr_submit_ $serverId]
} else {
#
# NOTE: Forcibly reset URN variables to their default values.
#
setupRepositoryServerVars true
}
}
#
# NOTE: This procedure returns the base URI for the package repository
# server endpoint that is used to lookup packages. There are no
# server. There are no arguments.
# arguments.
#
proc getLookupBaseUri {} {
global env
variable baseUri
variable lookupUri
variable lookupUrn
set varName [appendArgs [getLookupVarNamePrefix] lookup_base_uri]
if {[info exists $varName]} then {
return [set $varName]
}
set varName [string trim $varName :]
if {[info exists env($varName)]} then {
return $env($varName)
}
return [subst $lookupUri]
}
#
# NOTE: This procedure returns the base URI for the package repository
# server endpoint that is used to submit packages. There are no
# arguments.
#
# <internal>
proc getLookupBaseUri {} {
proc getSubmitBaseUri {} {
global env
variable baseUri
variable submitUri
variable submitUrn
set varName [appendArgs [getLookupVarNamePrefix] base_uri]
set varName [appendArgs [getLookupVarNamePrefix] submit_base_uri]
if {[info exists $varName]} then {
return [set $varName]
}
set varName [string trim $varName :]
if {[info exists env($varName)]} then {
return $env($varName)
}
return https://urn.to/r/pkg; # NOTE: System default.
return [subst $submitUri]
}
#
# NOTE: This procedure returns the full URI to use when looking up a
# specific package via the package repository server. The apiKeys
# argument is the list of API keys to use -OR- an empty list if a
# public package is being looked up. The package argument is the
|
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
|
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
|
+
+
+
+
+
+
+
|
#
# NOTE: Attempt to read optional settings file now. This may override
# one or more of the variable setup in the next step.
#
maybeReadSettingsFile [info script]
#
# NOTE: Setup the server and URI variables, in this namespace, that are
# used by this script.
#
setupRepositoryServerVars false
setupRepositoryUriVars false
#
# NOTE: Setup the variables, within this namespace, used by this script.
#
setupPackageUnknownVars
#
# NOTE: Setup for our [package unknown] handler, which may involve a few
|