Diff
Not logged in

Differences From Artifact [a24ae288ef]:

To Artifact [8f95de070a]:


55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
      set baseUri https://urn.to/r/pkgd
    }

    #
    # 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}?...&filename=${fileName}&m=bin

    if {![info exists downloadUri]} then {
      set downloadUri {${baseUri}?download&ci=trunk&filename=${fileName}&m=bin}
    }

    #
    # NOTE: The root directory where any persistent packages will be saved.
    #
    variable persistentRootDirectory; # DEFAULT: [getPersistentRootDirectory]








|


|







55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
      set baseUri https://urn.to/r/pkgd
    }

    #
    # 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}?...&filename=${fileName}

    if {![info exists downloadUri]} then {
      set downloadUri {${baseUri}?download&ci=trunk&filename=${fileName}}
    }

    #
    # NOTE: The root directory where any persistent packages will be saved.
    #
    variable persistentRootDirectory; # DEFAULT: [getPersistentRootDirectory]

80
81
82
83
84
85
86










87
88
89
90
91
92
93
    variable temporaryRootDirectory; # DEFAULT: [getFileTempDirectory PKGD_TEMP]

    if {![info exists temporaryRootDirectory]} then {
      set temporaryRootDirectory \
          [::PackageRepository::getFileTempDirectory PKGD_TEMP]
    }
  }











  #
  # NOTE: This procedure returns the root directory where any packages that
  #       are downloaded should be saved to permanent storage for subsequent
  #       use.  There are no arguments.
  #
  proc getPersistentRootDirectory {} {







>
>
>
>
>
>
>
>
>
>







80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
    variable temporaryRootDirectory; # DEFAULT: [getFileTempDirectory PKGD_TEMP]

    if {![info exists temporaryRootDirectory]} then {
      set temporaryRootDirectory \
          [::PackageRepository::getFileTempDirectory PKGD_TEMP]
    }
  }

  #
  # NOTE: This procedure returns a directory name suffix that is unique to
  #       the running process at the current point in time.  There are no
  #       arguments.
  #
  proc getUniqueDirectorySuffix {} {
    return [appendArgs \
        [string trim [pid] -] _ [string trim [clock seconds] -]]
  }

  #
  # NOTE: This procedure returns the root directory where any packages that
  #       are downloaded should be saved to permanent storage for subsequent
  #       use.  There are no arguments.
  #
  proc getPersistentRootDirectory {} {
191
192
193
194
195
196
197
























































































198
199
200
201
202
203
204
        }
      }
    } else {
      error "unsupported language, no idea how to modify auto-path"
    }
  }

























































































  #
  # NOTE: This procedure downloads a single file from the package file server,
  #       writing its contents to the specified local file name.  It can also
  #       verify the OpenPGP signatures.  When an OpenPGP signature file is
  #       downloaded, this procedure assumes the corresponding data file was
  #       already downloaded (i.e. since OpenPGP needs both to perform the
  #       signature checks).  The language argument must be one of the







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







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
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
        }
      }
    } else {
      error "unsupported language, no idea how to modify auto-path"
    }
  }

  #
  # NOTE: This procedure verifies the combination of language and version
  #       specified by the caller.  The language argument must be one of the
  #       literal strings "eagle", "tcl", or "client".  The version argument
  #       must be one of the literal strings "8.4", "8.5", or "8.6" when the
  #       language is "tcl" -OR- the literal string "1.0" when the language
  #       is either "eagle" or "client".  The varName argument is the name
  #       of a scalar variable in the context of the immediate caller that
  #       will receive a boolean value indicating if the specified language
  #       is actually a reference to the package downloader client itself.
  #
  proc verifyLanguageAndVersion { language version varName } {
    if {[string length $varName] > 0} then {
      upvar 1 $varName isClient
    }

    set isClient false

    if {[string length $language] == 0 || $language eq "eagle"} then {
      if {$version ne "1.0"} then {
        error "unsupported Eagle version"
      }
    } elseif {$language eq "tcl"} then {
      if {$version ne "8.4" && $version ne "8.5" && $version ne "8.6"} then {
        error "unsupported Tcl version"
      }
    } elseif {$language eq "client"} then {
      if {$version ne "1.0"} then {
        error "unsupported client version"
      }

      set isClient true
    } else {
      error "unsupported language"
    }
  }

  #
  # NOTE: This procedure checks if there is a higher version available of the
  #       specified package on the package file server.  The language argument
  #       must be one of the literal strings "eagle", "tcl", or "client".  The
  #       version argument must be one of the literal strings "8.4", "8.5", or
  #       "8.6" when the language is "tcl" -OR- the literal string "1.0" when
  #       the language is either "eagle" or "client".  The packageName argument
  #       is a directory name relative to the language and version-specific
  #       directory on the package file server and may be an empty string.  The
  #       usePgp argument should be non-zero when an OpenPGP signature file
  #       needs to be downloaded and verified for the downloaded file.
  #
  # <public>
  proc checkForHigherVersion { language version packageName usePgp } {
    variable clientDirectory
    variable temporaryRootDirectory

    verifyLanguageAndVersion $language $version isClient

    set temporaryDirectory [file join \
        $temporaryRootDirectory [appendArgs \
        pkgd_ver_ [getUniqueDirectorySuffix]]]

    if {$isClient} then {
      set persistentDirectory $clientDirectory
    } else {
      set persistentDirectory $persistentRootDirectory
    }

    set fileName [file join $packageName VERSION]
    set downloadFileName [file join $temporaryDirectory $fileName]

    file mkdir [file dirname $downloadFileName]
    downloadOneFile $language $version $fileName $downloadFileName $usePgp

    if {$usePgp} then {
      downloadOneFile $language $version [appendArgs $fileName .asc] \
          [appendArgs $downloadFileName .asc] $usePgp
    }

    set localFileName [file join $persistentDirectory $fileName]

    if {[package vcompare \
        [string trim [readFile $downloadFileName]] \
        [string trim [readFile $localFileName]]] > 0} then {
      return true
    } else {
      return false
    }
  }

  #
  # NOTE: This procedure downloads a single file from the package file server,
  #       writing its contents to the specified local file name.  It can also
  #       verify the OpenPGP signatures.  When an OpenPGP signature file is
  #       downloaded, this procedure assumes the corresponding data file was
  #       already downloaded (i.e. since OpenPGP needs both to perform the
  #       signature checks).  The language argument must be one of the
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
    #
    # NOTE: Then, in one step, download the file from the package file
    #       server and write it to the specified local file.
    #
    if {[isEagle]} then {
      writeFile $localFileName [interp readorgetscriptfile -- "" $uri]
    } else {
      writeFile $localFileName \
          [::PackageRepository::getFileViaHttp $uri 10 stdout $quiet]
    }

    #
    # NOTE: Is use of OpenPGP for signature verification enabled?  Also,
    #       did we just download an OpenPGP signature file?
    #
    if {$usePgp && [isPgpSignatureFileName $localFileName true]} then {







|
|







325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
    #
    # NOTE: Then, in one step, download the file from the package file
    #       server and write it to the specified local file.
    #
    if {[isEagle]} then {
      writeFile $localFileName [interp readorgetscriptfile -- "" $uri]
    } else {
      writeFile $localFileName [::PackageRepository::getFileViaHttp \
          $uri 10 stdout $quiet -binary true]
    }

    #
    # NOTE: Is use of OpenPGP for signature verification enabled?  Also,
    #       did we just download an OpenPGP signature file?
    #
    if {$usePgp && [isPgpSignatureFileName $localFileName true]} then {
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301

302
303
304
305
306
307
308
309
310
  # <public>
  proc downloadFiles {
          language version fileNames persistent usePgp useAutoPath } {
    variable clientDirectory
    variable persistentRootDirectory
    variable temporaryRootDirectory

    set client false

    if {[string length $language] == 0 || $language eq "eagle"} then {
      if {$version ne "1.0"} then {
        error "unsupported Eagle version"
      }
    } elseif {$language eq "tcl"} then {
      if {$version ne "8.4" && $version ne "8.5" && $version ne "8.6"} then {
        error "unsupported Tcl version"
      }
    } elseif {$language eq "client"} then {
      if {$version ne "1.0"} then {
        error "unsupported client version"
      }

      set client true
    } else {
      error "unsupported language"
    }

    set temporaryDirectory [file join $temporaryRootDirectory \
        [appendArgs pkgd_ [string trim [pid] -] _ [string trim \
        [clock seconds] -]]]


    if {$client} then {
      set persistentDirectory $clientDirectory
    } else {
      set persistentDirectory $persistentRootDirectory
    }

    set downloadedFileNames [list]








<
|
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
|
<
>

|







370
371
372
373
374
375
376

377



378














379
380

381
382
383
384
385
386
387
388
389
390
  # <public>
  proc downloadFiles {
          language version fileNames persistent usePgp useAutoPath } {
    variable clientDirectory
    variable persistentRootDirectory
    variable temporaryRootDirectory


    verifyLanguageAndVersion $language $version isClient


















    set temporaryDirectory [file join \
        $temporaryRootDirectory [appendArgs \

        pkgd_lib_ [getUniqueDirectorySuffix]]]

    if {$isClient} then {
      set persistentDirectory $clientDirectory
    } else {
      set persistentDirectory $persistentRootDirectory
    }

    set downloadedFileNames [list]

363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
      if {$persistent} then {
        set fileNameOnly [lindex $downloadedFileName 0]
        set directory(persistent) [lindex $downloadedFileName 2]

        file mkdir $directory(persistent)
        set command [list file copy]

        if {$client} then {
          lappend command -force
        }

        lappend command --
        lappend command [file join $directory(temporary) $fileNameOnly]
        lappend command [file join $directory(persistent) $fileNameOnly]








|







443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
      if {$persistent} then {
        set fileNameOnly [lindex $downloadedFileName 0]
        set directory(persistent) [lindex $downloadedFileName 2]

        file mkdir $directory(persistent)
        set command [list file copy]

        if {$isClient} then {
          lappend command -force
        }

        lappend command --
        lappend command [file join $directory(temporary) $fileNameOnly]
        lappend command [file join $directory(persistent) $fileNameOnly]