Diff
Not logged in

Differences From Artifact [e3a8e2742f]:

To Artifact [965d609d81]:


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
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







-
-
+
+
-

-
+
+
+
+
+
+
+
+
+
+
+











-
-
+
+

-
+

-
-
+
+







  \[language\] \[version\] \[platform\] \[fileName1\] ... \[fileNameN\]"

    exit 1
  }

  #
  # NOTE: This procedure sets up the default values for all configuration
  #       parameters used by the package uploader client.  The script
  #       argument is the fully qualified path and file name for the script
  #       parameters used by the package uploader client.  There are no
  #       arguments.
  #       being evaluated.
  #
  proc setupUploadVars { script } {
  proc setupUploadVars {} {
    #
    # NOTE: This variable must exist and must be the fully qualified path
    #       of the directory containing this script.
    #
    variable pkgr_path

    if {![info exists pkgr_path]} then {
      error "required namespace variable 'pkgr_path' does not exist"
    }

    #
    # NOTE: The project code for the Fossil repository.  This will be checked
    #       prior to staging or committing any files.
    #
    variable projectCode; # DEFAULT: 9ceada8dbb8678898e5b2c05386e73b3ff2c2dec

    if {![info exists projectCode]} then {
      set projectCode 9ceada8dbb8678898e5b2c05386e73b3ff2c2dec
    }

    #
    # NOTE: What is the fully qualified path to the directory containing the
    #       checkout for the package client?
    # NOTE: What is the fully qualified path to the directory containing
    #       package client toolset?
    #
    variable checkoutDirectory; # DEFAULT: <scriptDir>
    variable scriptDirectory; # DEFAULT: <scriptDir>

    if {![info exists checkoutDirectory]} then {
      set checkoutDirectory [file dirname $script]
    if {![info exists scriptDirectory]} then {
      set scriptDirectory $pkgr_path
    }

    #
    # NOTE: The command to use when attempting to check for changes prior to
    #       staging files using Fossil.
    #
    variable fossilChangesCommand; # DEFAULT fossil changes ...
88
89
90
91
92
93
94
95











96
97
98
99
100
101
102
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







-
+
+
+
+
+
+
+
+
+
+
+







    #
    # NOTE: The command to use when attempting to check the checkout status
    #       prior to staging files using Fossil.
    #
    variable fossilInfoCommand; # DEFAULT fossil info ...

    if {![info exists fossilInfoCommand]} then {
      set fossilInfoCommand {fossil info --chdir {${checkoutDirectory}}}
      set fossilInfoCommand {fossil info --chdir {${scriptDirectory}}}
    }

    #
    # NOTE: The regular expression pattern used when attempting to extract
    #       the root directory for the Fossil checkout.
    #
    variable fossilInfoLocalRootPattern; # DEFAULT: {^local-root:\s+(.*?)$}

    if {![info exists fossilInfoLocalRootPattern]} then {
      set fossilInfoLocalRootPattern {^local-root:\s+(.*?)$}
    }

    #
    # NOTE: The regular expression pattern used when attempting to verify
    #       that the Fossil checkout belongs to the correct project.
    #
    variable fossilInfoProjectCodePattern; # DEFAULT: {^project-code:\\s+...\$}
131
132
133
134
135
136
137
138

139
140
141
142
143
144
145
150
151
152
153
154
155
156

157
158
159
160
161
162
163
164







-
+







    # NOTE: The command to use when attempting to stage package files using
    #       Fossil.
    #
    variable fossilAddCommand; # DEFAULT fossil add ...

    if {![info exists fossilAddCommand]} then {
      set fossilAddCommand \
          {fossil add  --chdir {${checkoutDirectory}} {${fileName}}}
          {fossil add --chdir {${targetDirectory}} {${fileName}}}
    }

    #
    # NOTE: The command to use when attempting to commit package files using
    #       Fossil.
    #
    variable fossilCommitCommand; # DEFAULT fossil commit ...
165
166
167
168
169
170
171


















172
173
174
175
176
177
178
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    #
    variable verboseMetadataSubmit; # DEFAULT: false

    if {![info exists verboseMetadataSubmit]} then {
      set verboseMetadataSubmit false
    }
  }

  #
  # NOTE: This procedure sets up the default values for all configuration
  #       parameters used by the package uploader client that require the
  #       location of the checkout directory.  There are no arguments.
  #
  proc setupCheckoutVars {} {
    #
    # NOTE: What is the fully qualified path to the root directory of the
    #       Fossil checkout containing the package client toolset?  This
    #       procedure may raise script errors.
    #
    variable checkoutDirectory; # DEFAULT: <checkoutDir>

    if {![info exists checkoutDirectory]} then {
      set checkoutDirectory [getCheckoutDirectory]
    }
  }

  #
  # NOTE: This procedure returns a string value, formatted for use within a
  #       script block being processed by the [string map] command.  The
  #       value argument is the string value to format.  No return value is
  #       reserved to indicate an error.  This procedure may not raise any
  #       script errors.
530
531
532
533
534
535
536



























































537
538
539
540
541
542
543
544
545


546
547
548
549
550
551
552
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+









+
+








      return [eval ::PackageRepository::getFileViaHttp \
          [list $uri] [list 20] [list stdout] [list \
          [expr {!$verboseMetadataSubmit}]] $options]
    }
  }

  #
  # NOTE: This procedure attempts to query the root directory of the Fossil
  #       checkout.  There are no arguments.  An empty string is returned if
  #       the root directory of the Fossil checkout cannot be determined.
  #
  proc getCheckoutDirectory {} {
    variable fossilInfoCommand
    variable fossilInfoLocalRootPattern
    variable scriptDirectory

    if {[isEagle]} then {
      if {[catch {
        eval exec -nocarriagereturns -stdout output -stderr error \
            [subst $fossilInfoCommand]
      } result] == 0} then {
        set result [appendArgs $output $error]
      } else {
        return false
      }
    } else {
      if {[catch {
        eval exec [subst $fossilInfoCommand]
      } result]} then {
        return false
      }
    }

    if {![info exists result] || ![regexp -line -- \
        $fossilInfoLocalRootPattern $result dummy directory]} then {
      return ""
    }

    return [string trim $directory]
  }

  #
  # NOTE: This procedure attempts to verify that the root directory of the
  #       Fossil checkout is present, valid, and is actually a directory.
  #       There are no arguments.  Script errors will be raised if any of
  #       the checks fail.
  #
  proc verifyCheckoutDirectory {} {
    variable checkoutDirectory

    if {![info exists checkoutDirectory]} then {
      error "checkout directory is missing"
    }

    if {[string length $checkoutDirectory] == 0} then {
      error "checkout directory is invalid"
    }

    if {![file isdir $checkoutDirectory]} then {
      error [appendArgs \
          "checkout directory \"" $checkoutDirectory \
          "\" is not really a directory"]
    }
  }

  #
  # NOTE: This procedure attempts to verify that the checkout directory does
  #       not contain any (stray) changes.  There are no arguments.  Non-zero
  #       is returned if the verification is successful.
  #
  proc verifyThereAreNoChanges {} {
    variable checkoutDirectory
    variable fossilChangesCommand
    variable fossilChangesPattern

    verifyCheckoutDirectory

    if {[isEagle]} then {
      if {[catch {
        eval exec -nocarriagereturns -stdout output -stderr error \
            [subst $fossilChangesCommand]
      } result] == 0} then {
        set result [appendArgs $output $error]
571
572
573
574
575
576
577
578
579
580
581

582
583
584
585
586
587
588
669
670
671
672
673
674
675

676
677
678
679
680
681
682
683
684
685
686







-



+








  #
  # NOTE: This procedure attempts to verify that the checkout directory does
  #       belong to the correct project.  There are no arguments.  Non-zero
  #       is returned if the verification is successful.
  #
  proc verifyThisIsTheCorrectProject {} {
    variable checkoutDirectory
    variable fossilInfoCommand
    variable fossilInfoProjectCodePattern
    variable projectCode
    variable scriptDirectory

    if {[isEagle]} then {
      if {[catch {
        eval exec -nocarriagereturns -stdout output -stderr error \
            [subst $fossilInfoCommand]
      } result] == 0} then {
        set result [appendArgs $output $error]
607
608
609
610
611
612
613
614
615
616

617
618
619
620
621
622
623
705
706
707
708
709
710
711

712
713
714
715
716
717
718
719
720
721







-


+








  #
  # NOTE: This procedure attempts to verify that the checkout directory does
  #       belong to the correct branch.  There are no arguments.  Non-zero
  #       is returned if the verification is successful.
  #
  proc verifyThisIsTheCorrectBranch {} {
    variable checkoutDirectory
    variable fossilInfoCommand
    variable fossilInfoTagsPattern
    variable scriptDirectory

    if {[isEagle]} then {
      if {[catch {
        eval exec -nocarriagereturns -stdout output -stderr error \
            [subst $fossilInfoCommand]
      } result] == 0} then {
        set result [appendArgs $output $error]
645
646
647
648
649
650
651


652
653
654
655
656
657
658
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758







+
+







  #       directory.  There are no arguments.  This procedure may raise
  #       script errors.
  #
  proc changeToTheCorrectBranch {} {
    variable checkoutDirectory
    variable fossilUpdateCommand

    verifyCheckoutDirectory

    if {[isEagle]} then {
      if {[catch {
        eval exec -success Success [subst $fossilUpdateCommand]
      } error]} then {
        error [appendArgs \
            "could not change branch: " $error]
      }
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

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
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796


797






798



799


800
801

802
803


804
805
806
807


808
809
810
811
812
813
814
815
816
817
818
819
820
821
822







+
+

















-
-
+
-
-
-
-
-
-
+
-
-
-
+
-
-
+

-
+

-
-
+

+
+
-
-
+
+
+
+
+
+
+
+







  #       Fossil.  The fileNames argument is a list of (fully?) qualified
  #       local file names to stage.
  #
  # <public>
  proc stagePackageFiles { language version platform fileNames } {
    variable checkoutDirectory
    variable fossilAddCommand

    verifyCheckoutDirectory

    if {![verifyThereAreNoChanges]} then {
      error "cannot stage files: there are pending changes"
    }

    if {![verifyThisIsTheCorrectProject]} then {
      error "cannot stage files: wrong project"
    }

    if {![verifyThisIsTheCorrectBranch]} then {
      changeToTheCorrectBranch

      if {![verifyThisIsTheCorrectBranch]} then {
        error "cannot stage files: still on wrong branch"
      }
    }

    set newFileNames [list]

    set targetDirectory [file join \
    foreach fileName $fileNames {
      if {![::PackageRepository::createOpenPgpSignature $fileName]} then {
        error [appendArgs \
            "cannot stage file \"" $fileName "\": OpenPGP signing failed"]
      }

        $checkoutDirectory $language $version $platform]
      lappend newFileNames $fileName
      lappend newFileNames [appendArgs $fileName .asc]
    }


    set relativeFileNames [getRelativeFileNames $newFileNames 2]
    set relativeFileNames [getRelativeFileNames $fileNames 2]

    foreach fileName $newFileNames relativeFileName $relativeFileNames {
    foreach fileName $fileNames relativeFileName $relativeFileNames {
      file mkdir [file join \
          $checkoutDirectory $language $version $platform \
          [file dirname $relativeFileName]]
          $targetDirectory [file dirname $relativeFileName]]

      set checkoutFileName [file join $targetDirectory $relativeFileName]

      file copy $fileName \
          [file join $checkoutDirectory $relativeFileName]
      file copy $fileName $checkoutFileName

      if {![::PackageRepository::createOpenPgpSignature \
          $checkoutFileName]} then {
        error [appendArgs \
            "could not stage file \"" $fileName \
            "\": OpenPGP signing failed"]
      }

      set fileName $relativeFileName; # NOTE: For [subst].

      if {[isEagle]} then {
        set fileName [::PackageRepository::formatExecArgument $fileName]

        if {[catch {
743
744
745
746
747
748
749


750
751
752
753
754
755
756
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858







+
+







  #       caller that will receive the resulting Fossil check-in identifier.
  #
  # <public>
  proc commitPackageFiles { package patchLevel language version varName } {
    variable checkoutDirectory
    variable fossilCommitCommand
    variable fossilCommitPattern

    verifyCheckoutDirectory

    set branch [appendArgs pkg_ $package _ $patchLevel]

    set comment [appendArgs \
        "Add package " $package " v" $patchLevel " for " $language \
        " v" $version .]

1263
1264
1265
1266
1267
1268
1269

1270
1271
1272
1273
1274
1275
1276
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379







+







  #       and Tk.  The existing argument data, if any, will be used to
  #       populate it.  There are no arguments.
  #
  proc setupTkUserInterface {} {
    variable widgets

    package require Tk
    catch {console show}

    catch {wm withdraw .}; set toplevel [toplevel .uploader]
    set widgets(toplevel) $toplevel

    ###########################################################################

    set widgets(label,apiKey) [label [appendArgs \
1427
1428
1429
1430
1431
1432
1433
1434


1435
1436
1437
1438
1439
1440
1441
1530
1531
1532
1533
1534
1535
1536

1537
1538
1539
1540
1541
1542
1543
1544
1545







-
+
+







  #       one or more of the variable setup in the next step.
  #
  ::PackageRepository::maybeReadSettingsFile [info script]

  #
  # NOTE: Setup the variables, within this namespace, used by this script.
  #
  setupUploadVars [info script]
  setupUploadVars
  setupCheckoutVars

  #
  # NOTE: Provide the package to the interpreter.
  #
  package provide Eagle.Package.Uploader \
    [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}]