Rewrite of ListRegistries

APLSource/Client/DefineRegistry.aplc

@@ -35,6 +35,12 @@
       :Else
           ns.uri←y
       :EndIf
+      '"uri": invalid data type'Assert' '=1↑0⍴∊ns.uri
+      :If {1=≢'^http[s]?://'⎕S 0⊣⎕C ⍵}ns.uri
+      :AndIf 1<+/∊ns.uri=':'
+          ns.(uri port)←{((1⊃⍵),':',(2⊃⍵))(3⊃⍵)}':'(≠⊆⊢)ns.uri
+          ns.port←⊃⊃(//)⎕VFI ns.port
+      :EndIf
       'Invalid variables'Assert∧/(' '~¨⍨↓ns.⎕NL 2)∊varsList
       ⍎¨ns.{'_',⍵,'←','ns.',⍵}¨'id' 'uri' 'priority'      ⍝ use private fields for reserved properties
       ⍎¨ns.{⍵,'←','ns.',⍵}¨varsList~'id' 'uri' 'priority' ⍝ use property setters for validation on rest
@@ -145,6 +151,11 @@
         ∇ r←get
           r←_id
         ∇
+        ∇ set value
+          '"id": invalid depth'Assert 1=≡value.NewValue
+          '"id": invalid data type'Assert' '=1↑0⍴value.NewValue
+          _id←value.NewValue
+        ∇
     :EndProperty
 
     :Property proxy

APLSource/Client/EstablishRumbaClients.aplf

@@ -16,11 +16,11 @@
          ∆PermanentConnections←⎕NS''
      :EndIf
      regs←ListRegistries''
-     regs←(0<regs[;4])⌿regs
-     regs←(IsHTTP¨regs[;1])⌿regs
+     regs←(0<regs[;RegistryIndices.priority])⌿regs
+     regs←(IsHTTP¨regs[;RegistryIndices.url])⌿regs
      'No registries found'Assert 0<≢regs
      :Trap 345
-         Connect2Client¨⊃¨CompileUrlPlusPort/¨↓regs[;1 3]
+         Connect2Client¨⊃¨CompileUrlPlusPort/¨↓regs[;RegistryIndices.(url port)]
      :Else
          qdmx←⎕DMX
          ⎕DL 0.2

APLSource/Client/EstablishStuffInTatinVars.aplf

@@ -1,4 +1,4 @@
- {r}←{makeHomeRelative}EstablishStuffInTatinVars(ref cfg folder);deps;ref2;res;msg;make;check;f
+ {r}←{makeHomeRelative}EstablishStuffInTatinVars(ref cfg folder);deps;ref2;res;msg;make;check;f;body
 ⍝ We establish some fns (Niladic for impersonating "constants") in TatinVars for convinience
  r←⍬
  makeHomeRelative←{0<⎕NC ⍵:⍎⍵ ⋄ 0}'makeHomeRelative'
@@ -19,7 +19,20 @@
  :Else
      f←folder
  :EndIf
- res←ref2.⎕FX'r←HOME' '⍝ Returns the folder the package was loaded from or an empty vector if that cannot be established anymore'('r←''',f,'''')':If ~⎕nexists r' 'r←''''' ':EndIf'
+ body←''
+ body,←⊂'r←HOME;⎕IO;⎕ML;dir;name;extension'
+ body,←⊂'⍝ Returns folder package was loaded from or current directory or an empty vector if both are not valid'
+ body,←⊂'⎕IO←1 ⋄ ⎕ML←1'
+ body,←⊂('r←''',f,'''   ⍝ Original source')
+ body,←⊂':If ~⎕nexists r'
+ body,←⊂'(dir name extension)←⎕NPARTS r'
+ body,←⊂'r←(⊃1 ⎕NPARTS''''),(2⊃⎕NPARTS ¯1↓dir),''/'',name,extension ⍝ Try current dir'
+ body,←⊂':AndIf ~⎕nexists r'
+ body,←⊂'r←(⊃1 ⎕NPARTS''''),name,extension'
+ body,←⊂':AndIf ~⎕nexists r'
+ body,←⊂'r←'''''
+ body,←⊂':EndIf'
+ res←ref2.⎕FX body
  Assert/'HOME'make res
  ref2 check'HOME'
  res←ref2.⎕FX'r←ASSETS'('r←''',cfg.assets,'''')

APLSource/Client/FindDependencies.aplf

@@ -28,8 +28,8 @@
  :If '[]'≡¯2↑⌽¯1⌽target
      :If '[*]'≡target
          registries←1 ListRegistries''
-         target←(registries[;4]>0)⌿registries  ⍝ All Registries with a priority greater than 0
-         target←target[;1]
+         target←(registries[;RegistryIndices.priority]>0)⌿registries
+         target←target[;RegistryIndices.url]
      :ElseIf '[]'≡¯2↑⌽¯1⌽target
          target←ReplaceRegistryAlias target
      :EndIf

APLSource/Client/GetRegistriesForBuildList.aplf

@@ -2,8 +2,8 @@
 ⍝ Returns the URLs for all registries with a priority of greater than 0 (because we do not scan priority=0), ordered by priority.
 ⍝ The Registries are then pinged in order to find out whether they are up and running. Those which are not are remembered on ∆TREE.ignore
  buff←ListRegistries''
- buff←(buff[;4]>0)⌿buff
- r←⊃¨{⍵∊0 80 443:⍺ ⋄ ({⍵↓⍨-'/'=¯1↑⍵}⍺),':',(⍕⍵),'/'}/¨↓buff[;1 3]
+ buff←(buff[;RegistryIndices.priority]>0)⌿buff
+ r←⊃¨{⍵∊0 80 443:⍺ ⋄ ({⍵↓⍨-'/'=¯1↑⍵}⍺),':',(⍕⍵),'/'}/¨↓buff[;RegistryIndices.(url port)]
  r~←∆TREE.ignore
  r←∪r
 ⍝Done

APLSource/Client/ListRegistries.aplf

@@ -1,28 +1,27 @@
- r←{appendPort}ListRegistries type;data
+ r←{appendPort}ListRegistries type;data;RI
 ⍝ List all registries defined in the Client's config file.\\
 ⍝ Returns a matrix with these columns:
-⍝ * [;1] URL
-⍝ * [;2] Alias
-⍝ * [;3] Priority\\
-⍝ * [;4] API-key (optionally)
+⍝ * [;1] Alias
+⍝ * [;2] URL
+⍝ * [;3] ID
+⍝ * [;4] Port
+⍝ * [;5] Priority
+⍝ * [;6] NoCaching
+⍝ * [;7] Proxy
+⍝ * [;8] API-key (optionally)\\
 ⍝ "type" must be either 0 or 1 or empty:\\
 ⍝ * 1 means all data is listed
-⍝ * Everything else means just the alias, the uri and the priority are listed\\
+⍝ * Everything else means the API key is not listed\\
 ⍝ If ⍺ is 1 (default is 0) then the second column carries the uri plus the port
 ⍝ in case the  port is neither 80 nor 443.
  appendPort←{0<⎕NC ⍵:⍎⍵ ⋄ 0}'appendPort'
- r←(0,(2+3×1≡type))⍴''
+ RI←RegistryIndices
+ r←(0,((-1≢type)+≢RI.AllIndices))⍴''
  '"type" (⍵) must be a Boolean or empty'Assert(⊂type)∊0 1 ''⍬
  :If 0<≢data←MyUserSettings.registries
-     :If 1≡type
-         r←↑data.(alias uri port priority api_key)
-         r←r[⍒r[;4];]
-     :Else
-         r←↑data.(uri alias port priority)
-         r←r[⍒r[;4];]
-     :EndIf
+     r←(-1≢type)↓⍤1↑data.(alias uri id port priority noCaching proxy api_key)
+     r←r[⍒r[;RI.priority];]
  :EndIf
- :If 0<≢r
- :AndIf appendPort
-     r[;1]←BindProtocolWithPort¨↓r[;1 3]
+ :If appendPort∧0<≢r
+     r[;RI.url]←BindProtocolWithPort¨↓r[;RI.(url port)]
  :EndIf

APLSource/Client/ListVersions.aplf

@@ -1,4 +1,4 @@
- mat←{dateFlag}ListVersions url;client;request;res;url_;registries;registry;buff;flag;port;packageID
+ mat←{dateFlag}ListVersions url;client;request;res;url_;registries;registry;buff;flag;port;packageID;RI
 ⍝ Lists all versions of a package.
 ⍝ `url` is one of:
 ⍝  * An (optional) registry followed by "group" and "name" of a package
@@ -16,14 +16,15 @@
 ⍝ By default the publishing date is not included, but you my change this by passing a 1 as ⍺.
 ⍝ In that case an additional column is added to the result.
  dateFlag←{0<⎕NC ⍵:⍎⍵ ⋄ 0}'dateFlag'
+ RI←RegistryIndices
  :If flag←'[*]'≡3⍴url           ⍝ Special syntax!
  :OrIf (~IsHTTP url)∧('['≠1⍴url)∧({1≥+/⍵∊'/\'}url)∧(~':'∊url)∧('.'≠1⍴url)
      packageID←(flag×3)↓url
      mat←(0,(2+dateFlag))⍴⍬
      registries←ListRegistries 0
-     :If 0<≢registries←(0<registries[;4])⌿registries ⍝ Ignore those with a priority of 0
-     :AndIf 0<≢registries←({(⍳≢⍵)=⍵⍳⍵}registries[;1])⌿registries
-         :For registry port :In ↓registries[;1 3]
+     :If 0<≢registries←(0<registries[;RI.priority])⌿registries ⍝ Ignore those with a priority of 0
+     :AndIf 0<≢registries←({(⍳≢⍵)=⍵⍳⍵}registries[;RI.url])⌿registries
+         :For registry port :In ↓registries[;RI.(url port)]
              :If IsHTTP registry
                  url_←registry CompileUrlPlusPort port
              :Else

APLSource/Client/RegistryIndices.aplc

@@ -0,0 +1,28 @@
+:Class RegistryIndices
+⍝ Holds indices useful to index the array returned by `ListRegistries`
+
+    :Field Public Shared ReadOnly alias←1
+    :Field Public Shared ReadOnly url←2
+    :Field Public Shared ReadOnly id←3
+    :Field Public Shared ReadOnly port←4
+    :Field Public Shared ReadOnly priority←5
+    :Field Public Shared ReadOnly noCaching←6
+    :Field Public Shared ReadOnly proxy←7
+    :Field Public Shared ReadOnly apiKey←8
+
+    ∇ r←AllIndices
+      :Access Public Shared
+      r←alias,url,id,port,priority,noCaching,proxy,apiKey
+    ∇
+
+    ∇ r←AllNames
+      :Access Public Shared
+      r←'Alias' 'URL' 'ID' 'Port' 'Priority' 'No-Caching' 'Proxy' 'API-key'
+    ∇
+
+    ∇ r←IndicesAndNames
+      :Access Public Shared
+      r←⍉↑AllIndices AllNames
+    ∇
+
+:EndClass

APLSource/Client/UserSettings.aplc

@@ -282,7 +282,7 @@
       :Access Public Instance
       r←⍬
       'There is no such registry yet'Assert 0<≢_registries
-      :If 0<registry.⎕NC'id'    ⍝ Old stuff might lack ID (introduced with 0.74.0)
+      :If 0>registry.⎕NC⊂'id'    ⍝ Old stuff might lack ID (introduced with 0.74.0)
           ind←_registries.id⍳⊂registry.id
       :Else
           ind←_registries.uri⍳⊂registry.uri

APLSource/Registry/Base64_Encode.aplf

@@ -0,0 +1,15 @@
+ r←{loop}Base64_Encode data
+⍝ Base64-encodes "data". Tries to do it in one go but falls back to a loop if that causes a WS FULL
+⍝ `loop` defaults to 0, meaning that we first try to encode the data in one go but fall back to a loop in case of a WS FULL.
+⍝ You may specify a 1 as left argument in order to enforce the loop
+ loop←{0<⎕NC ⍵:⍎⍵ ⋄ 0}'loop'
+ :If 0=loop
+     :Trap 1 ⍝ WS FULL
+         r←1 Base64_ data
+     :Else
+         →∆Loop
+     :EndTrap
+     :Return
+ :EndIf
+⍝ -------------------------------
+∆Loop:

APLSource/Registry/History.apla

@@ -1,7 +1,13 @@
 (
- '* 0.103.3 ⋄ 2024-01-18'
- '  * In the user command script the function `IsScripted` traps 16 rather than 0.'
- '  * Bug fix: UpdateClient had a problem with `Run.aplf` '
+ '* 0.104.0 ⋄ 2024-01-22'
+ '  * The results of both `]ListRegistries` and its API counterpart have changed. '
+ '  * `TatinVars.HOME` is now much more flexible now, addressing Dyalog stand-alone applications'
+ '  * Bug fixes'
+ '    * `UpdateClient` had a problem with `Run.aplf`'
+ '    * `UserSettings.ReplaceRegistry` did not correcly identify an `id`'
+ '    * `DefineRegistry` did not allow changing the `id`'
+ '    * `DefineRegistry`''s constructor did not handle a port number as in `''https://localhost:9090''`'
+ '    * `Client.ListRegistries` did not return the `id` - delivers now a changed and complete result'
  '* 0.103.2 ⋄ 2024-01-16'
  '  * New version of FilesAndDirs integrated'
  '  * ]UserSettings now accepts a flag -home that prints the folder hosting the user settings file'

APLSource/Registry/Version.aplf

@@ -1,3 +1,3 @@
  r←Version
  ⍝ See also `History`
- r←'Tatin' '0.103.3+1740' '2024-01-17'
+ r←'Tatin' '0.104.0+1754' '2024-01-22'

APLSource/Server/Handle_PUT_And_POST.aplf

@@ -11,8 +11,9 @@
  :EndIf
  :If G.Credentials AcceptCredential apiKey groupName
      :If 0=≢'email'Reg.GetGroupData G.RegistryPath groupName
-     :AndIf 0 G.INI.Get 'CONFIG:EnforceEmailAddress'
-         response←request RespondWithHTML 400 'No email address defined' 'You cannot publish without defining an email address for your group.'
+     :AndIf 0 G.INI.Get'CONFIG:EnforceEmailAddress'
+         response←request Respond 400
+         response.Content←'You cannot publish without defining an email address for your group.'
      :Else
          :If Reg.IsValidPackageID_Complete request.RequestTarget
              response←SavePackage request

APLSource/Tatin.dyalog

@@ -1,6 +1,6 @@
 :Namespace Tatin
 ⍝ The ]Tatin user commands for managing packages.\\
-⍝ * 0.77.0 - 2024-01-16
+⍝ * 0.77.1 - 2024-01-21
 
     ⎕IO←1 ⋄ ⎕ML←1
 
@@ -1039,17 +1039,26 @@
                   qdmx.EM ⎕SIGNAL ErrNo
               :EndSelect
           :Else
-              :If firstFlag
-              :AndIf 'Server: The package has already been published'{⍺≡(≢⍺)↑⍵}qdmx.EM
-              :AndIf 'Any'≡⎕SE.Tatin.GetDeletePolicy url_
-                  packageID←2⊃⎕NPARTS source
-              :AndIf TC.C.YesOrNo packageID,' already published on ',url_,'; overwrite?'
-                  firstFlag←0
-                  (rc msg)←⎕SE.Tatin.DeletePackage url,packageID
-                  :If 200=rc
-                      →∆Again
+              :If 'Server: The package has already been published'{⍺≡(≢⍺)↑⍵}qdmx.EM
+                  :If 'Any'≡⎕SE.Tatin.GetDeletePolicy url_
+                      :If firstFlag
+                          packageID←2⊃⎕NPARTS source
+                          :If TC.C.YesOrNo packageID,' already published on ',url_,'; overwrite?'
+                              firstFlag←0
+                              (rc msg)←⎕SE.Tatin.DeletePackage url,packageID
+                              :If 200=rc
+                                  →∆Again
+                              :Else
+                                  ⎕←'Delete attempt failed with status ',(⍕rc),'; publishing therefore not possible'
+                                  :Return
+                              :EndIf
+                          :EndIf
+                      :Else
+                          ⎕←'Deleting already published package failed with status ',(⍕rc),'; publishing therefore not possible'
+                          :Return
+                      :EndIf
                   :Else
-                      ⎕←'Delete attempt failed with status ',(⍕rc),'; publishing therefore not possible'
+                      ⎕←'Server does not allow overwriting an already published package; publishing therefore not possible'
                       :Return
                   :EndIf
               :EndIf
@@ -1126,13 +1135,14 @@
       :EndIf
     ∇
 
-    ∇ r←ListRegistries Arg;type
+    ∇ r←ListRegistries Arg;type;captions
       type←0
       :If 0≢Arg.Switch'full'
           type←Arg.Switch'full'
       :EndIf
       r←TC.ListRegistries type
-      r←((,[0.5]'URI' 'Alias' 'Port' 'Priority',(1≡type)/⊂'API-key'),[1]' ')⍪r
+      captions←TC.RegistryIndices.AllNames
+      r←((,[0.5](-1≢type)↓captions),[1]' ')⍪r
       r[2;]←(⌈⌿≢¨r)⍴¨'-'
     ∇
 
@@ -1184,7 +1194,7 @@
       :Trap ErrNo
           :If '[?]'{⍺≡(≢⍺)↑⍵}arg
               'No package specified'Assert 0<≢{⍵↓⍨⌈/⍵⍳'?]'}arg
-              buff←{⍵[;1 2]}TC.ListRegistries 0
+              buff←{⍵[;,2]}1 TC.ListRegistries 0
               ind←'Please select a Registry:'TC.C.Select↓⎕FMT buff
               :If 0=≢ind
                   r←'Cancelled by user'
@@ -1603,10 +1613,10 @@
       :If 0≡registry   ⍝ No argument specified? We ping all we know about!
           r←0 2⍴⍬
           :If 0<≢registries←GetListOfRegistriesForSelection 0
-          :AndIf 0<≢registries←(TC.Reg.IsHTTP¨registries[;1])⌿registries
-          :AndIf 0<≢registries←registries[∪{⍵⍳⍵}registries[;1];] ⍝ Because the same URL might turn up multiple times with different credentials/alias
+          :AndIf 0<≢registries←(TC.Reg.IsHTTP¨registries[;2])⌿registries
+          :AndIf 0<≢registries←registries[∪{⍵⍳⍵}registries[;2];] ⍝ Because the same URL might turn up multiple times with different credentials/alias
               ⎕←'Questioning ',(⍕≢registries),' Tatin Registr',((1+1=≢registries)⊃'ies' 'y'),'...'
-              r←{⍵,[1.5]⎕TSYNC{TC.Ping ⍵}¨&⍵}registries[;1]
+              r←{⍵,[1.5]⎕TSYNC{TC.Ping ⍵}¨&⍵}registries[;2]
           :EndIf
       :ElseIf (,'?')≡,registry
           :If 0=≢registries←1 SelectRegistry 0
@@ -1759,7 +1769,7 @@
               r,←⊂'Returns information regarding the licenses tolerated by a managed Tatin Registry'
               r,←'' '  ]Tatin.ListLicenses <url> -verbose'
           :Case ⎕C'ListRegistries'
-              r,←⊂'List URL, alias, priority and port of all Registries as defined in the user settings.'
+              r,←⊂'List Alias, URL, ID, port and priority all Registries as defined in the user settings.'
               r,←'' '  ]Tatin.ListRegistries -full'
           :Case ⎕C'ListDeprecated'
               r,←⊂'List all deprecated major versions'
@@ -1923,17 +1933,17 @@
               r,←⊂''
               r,←⊂'-verbose  If specified not only the names of the licenses are returned but also their URLs.'
           :Case ⎕C'ListRegistries'
-              r,←⊂'Lists URL, alias, priority, port  and the no-caching flag of all Registries as defined'
+              r,←⊂'Lists alias, URL, ID, port, priority and the no-caching flag of all Registries as defined'
               r,←⊂'in the user settings.'
               r,←⊂'The result is ordered by priority: the one with the highest priority is listed first etc.'
               r,←⊂''
               r,←⊂'Notes:'
               r,←⊂' * Registries with a priority of 0 will not participate in a scan of Registries'
               r,←⊂' * In case a Registry does not respond when questioned by ]ListRegistries the user is'
-              r,←⊂'   given three options: Retry, skip and cancel operation'
+              r,←⊂'   given three options: Retry, skip and cancel the whole operation'
               r,←⊂''
-              r,←⊂'-full By default all data but the API keys are listed. Specify -full if you want the'
-              r,←⊂'      API keys to be listed as well.'
+              r,←⊂'-full   By default all data but the API keys are listed. Specify -full if you want the'
+              r,←⊂'        API keys to be listed as well.'
           :Case ⎕C'ListDeprecated'
               r,←⊂'Lists all deprecated major versions'
               r,←⊂''
@@ -2499,8 +2509,8 @@
 
     ∇ r←GetListOfRegistriesForSelection type
       :If 0<≢r←TC.ListRegistries type
-          r[;2]←{0=≢⍵:'' ⋄ '[',⍵,']'}¨r[;2]
-          r[;1]←r[;1]{⍵∊0 80 443:⍺ ⋄ (¯1↓⍺),':',(⍕⍵),'/'}¨r[;3]
+          r[;1]←{0=≢⍵:'' ⋄ '[',⍵,']'}¨r[;1]
+          r[;2]←r[;2]{⍵∊0 80 443:⍺ ⋄ (¯1↓⍺),':',(⍕⍵),'/'}¨r[;4]
       :EndIf
     ∇
 
@@ -2509,7 +2519,7 @@
       :If 1=≢list←GetListOfRegistriesForSelection type
           registry←1⊃list[1;]
       :Else
-          :If ⍬≡row←'Select Tatin Registry'all TC.C.Select↓⎕FMT list[;2 1]
+          :If ⍬≡row←'Select Tatin Registry'all TC.C.Select↓⎕FMT list[;1 2]
               registry←⍬
           :Else
               :If all

APLSource/TestCases/Cleanup.aplf

@@ -1,6 +1,6 @@
  Cleanup;F;folder;configFolder;rc;msg;res
  ##.Client.⎕EX'∆PrintToSession'
- ##.Admin.⎕EX¨'∆DIRS' '∆FILES'
+ ##.Admin.⎕EX¨'∆DIRS' '∆FILES' 'RI'
  ⎕SE._Tatin.Client.⎕EX'∆PrintToSession'
  F←##.FilesAndDirs
  folder←(739⌶0),'/TatinTests/'

APLSource/TestCases/Initial.aplf

@@ -2,6 +2,7 @@
  #.⎕EX'_tatin'
  r←1
 
+ RI←##.Client.RegistryIndices
 ⍝ Managed Registry:
  ∆TEMP_SERVER_FOLDER←F.GetTempSubDir'Tatin-Test-Server'
  (∆TEMP_SERVER_FOLDER,'/')⎕NCOPY⍠1⊣#.Tatin.CiderConfig.HOME,'/TestServer/*'