[bug#36919] [PATCH 0/2] Make the KDE updater find packaes in subdirectories

[bug#36919] [PATCH 0/2] Make the KDE updater find packaes in subdirectories

[Hartmut Goebel]

Als make the KDE updater no longer rely on FTP access.

Formerly packages living in a path like
/stable/frameworks/5.60/portingAids/kross-5.60.0.tar.xz
have not been found due to the additional directory level.

These patches change the KDE updater to download the "ls -lR" file from
downloader.kde.org and use a pattern for searching the relevant files.

Sine I'm sitt a beginner in Guile, I apprechiate any enhancement suggestion to
the code. I assume esp. the loop in download.kde.org-files and
canonicalize-path could be written more scheme-ish.

Hartmut Goebel (2):
  gnu-maintenance: KDE updater no longer relies on FTP access.
  gnu-maintenance: KDE updater finds packages even in sub-directory.

 guix/gnu-maintenance.scm | 99 +++++++++++++++++++++++++++++++++++++---
 1 file changed, 92 insertions(+), 7 deletions(-)

-- 
2.21.0

[bug#36919] [PATCH 0/2] Make the KDE updater find packaes in subdirectories

[Hartmut Goebel]

Als make the KDE updater no longer rely on FTP access.

Formerly packages living in a path like
/stable/frameworks/5.60/portingAids/kross-5.60.0.tar.xz
have not been found due to the additional directory level.

These patches change the KDE updater to download the "ls -lR" file from
downloader.kde.org and use a pattern for searching the relevant files.

Sine I'm sitt a beginner in Guile, I apprechiate any enhancement suggestion to
the code. I assume esp. the loop in download.kde.org-files and
canonicalize-path could be written more scheme-ish.

Hartmut Goebel (2):
  gnu-maintenance: KDE updater no longer relies on FTP access.
  gnu-maintenance: KDE updater finds packages even in sub-directory.

 guix/gnu-maintenance.scm | 99 +++++++++++++++++++++++++++++++++++++---
 1 file changed, 92 insertions(+), 7 deletions(-)

-- 
2.21.0

[bug#36919] [PATCH 1/2] gnu-maintenance: KDE updater no longer relies on FTP access.

[Hartmut Goebel]

* guix/gnu-maintenance.scm (%kde-file-list-uri): New variable.
  (download.kde.org-files): New procedure.
  (latest-kde-release): Change to use DOWNLOAD.KDE.ORG-FILES and search
  for files in this list.
---
 guix/gnu-maintenance.scm | 77 ++++++++++++++++++++++++++++++++++++----
 1 file changed, 70 insertions(+), 7 deletions(-)

diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index d63d44f629..730e2519ee 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org>
+;;; Copyright © 2019 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,6 +25,7 @@
   #:use-module (sxml simple)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
@@ -615,15 +617,76 @@ releases are on gnu.org."
 (define gnu-hosted?
   (url-prefix-predicate "mirror://gnu/"))
 
+(define %kde-file-list-uri
+  ;; URI of the file list (ls -lR format) for download.kde.org.
+  (string->uri "https://download.kde.org/ls-lR.bz2"))
+
+(define download.kde.org-files
+  (mlambda ()
+    "Return the list of files available at download.kde.org."
+    ;; XXX: Memoize the whole procedure to work around the fact that
+    ;; 'http-fetch/cached' caches the bzip2-compressed version.
+
+    (define (canonicalize-path path)
+      (if (string-prefix? "/srv/archives/ftp/" path)
+          (set! path (string-drop path 17)))
+      (if (string-suffix? ":" path)
+          (set! path (string-drop-right path 1)))
+      (if (not (string-suffix? "/" path))
+          (set! path (string-append path "/")))
+      path)
+
+    (define (ls-lR-line->filename path line)
+      ;; remove mode, blocks, user, group, size, date, time and one space
+      (regexp-substitute
+       #f (string-match "^(\\S+\\s+){6}\\S+\\s" line) path 'post))
+
+    (let ((entries `())
+          (port (decompressed-port
+                 'bzip2
+                 (http-fetch/cached %kde-file-list-uri #:ttl 3600))))
+      (do ((path (read-line port) (read-line port)))
+          ((or (eof-object? path) (string= path "")))
+        (set! path (canonicalize-path path))
+        (do ((line (read-line port) (read-line port)))
+            ((or (eof-object? line) (string= line "")))
+          (if (string-prefix? "-" line)
+              ;; regular file
+              (set! entries
+                    (cons (ls-lR-line->filename path line)
+                          entries)))))
+      entries)))
+
 (define (latest-kde-release package)
   "Return the latest release of PACKAGE, the name of an KDE.org package."
-  (let ((uri (string->uri (origin-uri (package-source package)))))
-    (false-if-ftp-error
-     (latest-ftp-release
-      (package-upstream-name package)
-      #:server "ftp.mirrorservice.org"
-      #:directory (string-append "/sites/ftp.kde.org/pub/kde/"
-                                 (dirname (dirname (uri-path uri))))))))
+  (let* ((uri      (string->uri (origin-uri (package-source package))))
+         (directory  (dirname (dirname (uri-path uri))))
+         (name     (package-upstream-name package))
+         (files    (download.kde.org-files))
+         (relevant (filter (lambda (file)
+                             (and (string-prefix? directory file)
+                                  (release-file? name (basename file))
+                                  ))
+                           files)))
+    (match (sort relevant (lambda (file1 file2)
+                            (version>? (sans-extension (basename file1))
+                                       (sans-extension (basename file2)))))
+           ((and tarballs (reference _ ...))
+            (let* ((version  (tarball->version reference))
+                   (tarballs (filter (lambda (file)
+                                       (string=? (sans-extension
+                                                  (basename file))
+                                                 (sans-extension
+                                                  (basename reference))))
+                                     tarballs)))
+              (upstream-source
+               (package name)
+               (version version)
+               (urls (map (lambda (file)
+                            (string-append "mirror://kde/" file))
+                          tarballs)))))
+           (()
+            #f))))
 
 (define (latest-xorg-release package)
   "Return the latest release of PACKAGE, the name of an X.org package."
-- 
2.21.0

[bug#36919] [PATCH 1/2] gnu-maintenance: KDE updater no longer relies on FTP access.

[Ludovic Courtès]

Hi Hartmut,

Hartmut Goebel <h.goebel@crazy-compilers.com> skribis:

> * guix/gnu-maintenance.scm (%kde-file-list-uri): New variable.
>   (download.kde.org-files): New procedure.
>   (latest-kde-release): Change to use DOWNLOAD.KDE.ORG-FILES and search
>   for files in this list.

Nice!

How about moving this code to (guix import kde) as was done for (guix
import gnome) when we discussed it back then?  (See
<https://issues.guix.gnu.org/issue/28159>.)

> +(define download.kde.org-files
> +  (mlambda ()
> +    "Return the list of files available at download.kde.org."
> +    ;; XXX: Memoize the whole procedure to work around the fact that
> +    ;; 'http-fetch/cached' caches the bzip2-compressed version.
> +
> +    (define (canonicalize-path path)
> +      (if (string-prefix? "/srv/archives/ftp/" path)
> +          (set! path (string-drop path 17)))
> +      (if (string-suffix? ":" path)
> +          (set! path (string-drop-right path 1)))
> +      (if (not (string-suffix? "/" path))
> +          (set! path (string-append path "/")))
> +      path)

As a rule of thumb we don’t use ‘set!’ in Guix, except in special
circumstances.  In this case you can write:

  (define (canonicalize-path path)
    (cond ((string-prefix? …)
           (string-drop path 17))
          ((string-suffix? …)
           (string-drop-right path 1))
          …))

> +    (define (ls-lR-line->filename path line)
> +      ;; remove mode, blocks, user, group, size, date, time and one space
> +      (regexp-substitute
> +       #f (string-match "^(\\S+\\s+){6}\\S+\\s" line) path 'post))
> +
> +    (let ((entries `())
> +          (port (decompressed-port
> +                 'bzip2
> +                 (http-fetch/cached %kde-file-list-uri #:ttl 3600))))

What about passing ‘http-fetch/cached’ a custom #:write-cache, as is
done in (guix cve)?  That would allow us to store the cached file list
in a pre-processed (and possibly decompressed) format, speeding up
operation on cache hits.

> +      (do ((path (read-line port) (read-line port)))
> +          ((or (eof-object? path) (string= path "")))
> +        (set! path (canonicalize-path path))

I also recommend against ‘do’.  You can use a “named let” loop instead,
as in:

  (let loop ((files '()))
    (match (read-line port)
      ((? eof-object?)
       (reverse files))
      (line
       (loop (cons … files)))))

That’s about it.

Thanks!

Ludo’.

[bug#36919] [PATCH 1/2] gnu-maintenance: KDE updater no longer relies on FTP access.

[Hartmut Goebel]

Am 17.08.19 um 23:01 schrieb Ludovic Courtès:
> Nice!

Thansk :-)


> How about moving this code to (guix import kde) as was done for (guix
> import gnome) when we discussed it back then?  (See
> <https://issues.guix.gnu.org/issue/28159>.)

I'll be fine with this.

I just wonder whether we/I should refactor the new code to be more
flexible for other ls-lR cases and keep the common parts in
gnu-maintenance.scm. OTOH currently there is no other use-case

-- 
Regards
Hartmut Goebel

| Hartmut Goebel          | h.goebel@crazy-compilers.com               |
| www.crazy-compilers.com | compilers which you thought are impossible |

[bug#36919] [PATCH 1/2] gnu-maintenance: KDE updater no longer relies on FTP access.

[Ludovic Courtès]

Hi,

Hartmut Goebel <h.goebel@crazy-compilers.com> skribis:

>> How about moving this code to (guix import kde) as was done for (guix
>> import gnome) when we discussed it back then?  (See
>> <https://issues.guix.gnu.org/issue/28159>.)
>
> I'll be fine with this.
>
> I just wonder whether we/I should refactor the new code to be more
> flexible for other ls-lR cases and keep the common parts in
> gnu-maintenance.scm. OTOH currently there is no other use-case

Yeah, we’d have to identify what common parts exist.  On IRC we discussed
utility procedures like ‘file-sans-extension’, which would be worth
factorizing.

Other things may not be good candidates—for instance, the GNU thing is
probably close to what you’d write for KDE, but it’s still not exactly
the same.  Since there’s usually fine-tuning to be done, it may be best
to keep them separate.

> Am 17.08.19 um 23:01 schrieb Ludovic Courtès:
>> As a rule of thumb we don’t use ‘set!’ in Guix, except in special
>> circumstances.  In this case you can write:
>>
>>   (define (canonicalize-path path)
>>     (cond ((string-prefix? …)
>>            (string-drop path 17))
>>           ((string-suffix? …)
>>            (string-drop-right path 1))
>>           …))
>
> AFAIK, `cond` only processes the first expression where `test ` is true.
> In this case, we need to process *all* cases where the test is true.
> This means we need to nest the evaluation, which is ugly and hard to
> read IMHO. Is there some more "linear" syntax?

Oh I see.  You could roughly have one procedure for each clause and
chain them.  A macro might help make that more readable (Clojure has
‘->’).

HTH!

Ludo’.

[bug#36919] [PATCH 1/2] gnu-maintenance: KDE updater no longer relies on FTP access.

[Hartmut Goebel]

Hi Ludo,

thanks for the coding advice. This was what I've been asking for :-)
Just one point:

Am 17.08.19 um 23:01 schrieb Ludovic Courtès:
> As a rule of thumb we don’t use ‘set!’ in Guix, except in special
> circumstances.  In this case you can write:
>
>   (define (canonicalize-path path)
>     (cond ((string-prefix? …)
>            (string-drop path 17))
>           ((string-suffix? …)
>            (string-drop-right path 1))
>           …))

AFAIK, `cond` only processes the first expression where `test ` is true.
In this case, we need to process *all* cases where the test is true.
This means we need to nest the evaluation, which is ugly and hard to
read IMHO. Is there some more "linear" syntax?

(BTW: The manual [1] is not quite precise on `cond`, so I needed to test
it. Maybe I did it wrong.)

[1] https://www.gnu.org/software/guile/manual/html_node/Conditionals.html

-- 
Regards
Hartmut Goebel

| Hartmut Goebel          | h.goebel@crazy-compilers.com               |
| www.crazy-compilers.com | compilers which you thought are impossible |

[bug#36919] [PATCH 2/2] gnu-maintenance: KDE updater finds packages even in sub-directory.

[Hartmut Goebel]

Fixes <http://issues.guix.gnu.org/issue/30345> and
finally fixes <http://issues.guix.gnu.org/issue/25020>.

Formerly packages living in a path like
/stable/frameworks/5.60/portingAids/kross-5.60.0.tar.xz
have not been found.

* guix/gnu-maintenance.scm (uri->kde-path-pattern): New procedure.
  (latest-kde-release): Use pattern to search for file.
---
 guix/gnu-maintenance.scm | 26 ++++++++++++++++++++++++--
 1 file changed, 24 insertions(+), 2 deletions(-)

diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 730e2519ee..d76ef2c5aa 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -657,14 +657,36 @@ releases are on gnu.org."
                           entries)))))
       entries)))
 
+(define (uri->kde-path-pattern uri)
+
+  (define version-regexp
+    (make-regexp
+     (string-join '("^([0-9]+\\.)+[0-9]+-?"   ;; 5.12.90, 4.2.0-preview
+                    "^[0-9]+$"                ;; 20031002
+                    ".*-([0-9]+\\.)+[0-9]+$") ;; kdepim-4.6.1
+                    "|")))
+
+  (define (version->pattern part)
+    ;; If a path element might be a version´, replace it by a catch-all part
+    (if (regexp-exec version-regexp part)
+        "[^/]+"
+        part))
+
+  (let* ((path (uri-path uri))
+         (directory-parts (string-split (dirname path) #\/)))
+    (make-regexp
+     (string-append
+      (string-join (map version->pattern directory-parts) "/")
+      "/"))))
+
 (define (latest-kde-release package)
   "Return the latest release of PACKAGE, the name of an KDE.org package."
   (let* ((uri      (string->uri (origin-uri (package-source package))))
-         (directory  (dirname (dirname (uri-path uri))))
+         (path-rx  (uri->kde-path-pattern uri))
          (name     (package-upstream-name package))
          (files    (download.kde.org-files))
          (relevant (filter (lambda (file)
-                             (and (string-prefix? directory file)
+                             (and (regexp-exec path-rx file)
                                   (release-file? name (basename file))
                                   ))
                            files)))
-- 
2.21.0

[bug#36919] [Patch v2 0/4] Make the KDE updater find packages in subdirectories

[Hartmut Goebel]

Relevant changes:

* Moved kde code into a separete module. THis is done *after* the first change
  ("no longer relies on FTP access"9, since otherwise a lot of FTP-releated
  identifiers would have had to be exported in gnu-maintenance.scm.
* Using a custom write-cache to cache the evaluated file list, as suggested by
  Ludo
* Removed usage of 'set!'
* Using named let instead of 'do'


Hartmut Goebel (4):
  guix: Rename and move sans-extension to tarball-sans-extension.
  gnu-maintenance: KDE updater no longer relies on FTP access.
  upstream: Move KDE updater into a separate module.
  import: KDE updater finds packages even in sub-directory.

 Makefile.am              |   1 +
 guix/gnu-maintenance.scm |  44 +++------
 guix/import/kde.scm      | 190 +++++++++++++++++++++++++++++++++++++++
 guix/utils.scm           |   7 ++
 4 files changed, 210 insertions(+), 32 deletions(-)
 create mode 100644 guix/import/kde.scm

-- 
2.21.0

[bug#36919] [Patch v2 1/4] guix: Rename and move sans-extension to tarball-sans-extension.

[Hartmut Goebel]

* guix/gnu-maintenance.scm (sans-extension): Move and rename to ...
* guix/utils.scm (tarball-sans-extension): ... here.
---
 guix/gnu-maintenance.scm | 26 ++++++++++++--------------
 guix/utils.scm           |  7 +++++++
 2 files changed, 19 insertions(+), 14 deletions(-)

diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index d63d44f629..8fce956c60 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -230,12 +230,6 @@ network to check in GNU's database."
             (or (assoc-ref (package-properties package) 'ftp-directory)
                 (string-append "/gnu/" name)))))
 
-(define (sans-extension tarball)
-  "Return TARBALL without its .tar.* or .zip extension."
-  (let ((end (or (string-contains tarball ".tar")
-                 (string-contains tarball ".zip"))))
-    (substring tarball 0 end)))
-
 (define %tarball-rx
   ;; The .zip extensions is notably used for freefont-ttf.
   ;; The "-src" pattern is for "TeXmacs-1.0.7.9-src.tar.gz".
@@ -261,14 +255,15 @@ true."
                                           (string-append project
                                                          "-src")))))))
        (not (regexp-exec %alpha-tarball-rx file))
-       (let ((s (sans-extension file)))
+       (let ((s (tarball-sans-extension file)))
          (regexp-exec %package-name-rx s))))
 
 (define (tarball->version tarball)
   "Return the version TARBALL corresponds to.  TARBALL is a file name like
 \"coreutils-8.23.tar.xz\"."
   (let-values (((name version)
-                (gnu-package-name->name+version (sans-extension tarball))))
+                (gnu-package-name->name+version
+                 (tarball-sans-extension tarball))))
     version))
 
 (define* (releases project
@@ -492,8 +487,9 @@ return the corresponding signature URL, or #f it signatures are unavailable."
       (and (string=? url (basename url))          ;relative reference?
            (release-file? package url)
            (let-values (((name version)
-                         (package-name->name+version (sans-extension url)
-                                                     #\-)))
+                         (package-name->name+version
+                          (tarball-sans-extension url)
+                          #\-)))
              (upstream-source
               (package name)
               (version version)
@@ -565,14 +561,16 @@ list available from %GNU-FILE-LIST-URI over HTTP(S)."
                                     (release-file? name (basename file))))
                              files)))
       (match (sort relevant (lambda (file1 file2)
-                              (version>? (sans-extension (basename file1))
-                                         (sans-extension (basename file2)))))
+                              (version>? (tarball-sans-extension
+                                          (basename file1))
+                                         (tarball-sans-extension
+                                          (basename file2)))))
         ((and tarballs (reference _ ...))
          (let* ((version  (tarball->version reference))
                 (tarballs (filter (lambda (file)
-                                    (string=? (sans-extension
+                                    (string=? (tarball-sans-extension
                                                (basename file))
-                                              (sans-extension
+                                              (tarball-sans-extension
                                                (basename reference))))
                                   tarballs)))
            (upstream-source
diff --git a/guix/utils.scm b/guix/utils.scm
index f480c3291f..1f99c5b3f5 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -91,6 +91,7 @@
             arguments-from-environment-variable
             file-extension
             file-sans-extension
+            tarball-sans-extension
             compressed-file?
             switch-symlinks
             call-with-temporary-output-file
@@ -578,6 +579,12 @@ minor version numbers from version-string."
         (substring file 0 dot)
         file)))
 
+(define (tarball-sans-extension tarball)
+  "Return TARBALL without its .tar.* or .zip extension."
+  (let ((end (or (string-contains tarball ".tar")
+                 (string-contains tarball ".zip"))))
+    (substring tarball 0 end)))
+
 (define (compressed-file? file)
   "Return true if FILE denotes a compressed file."
   (->bool (member (file-extension file)
-- 
2.21.0

[bug#36919] [Patch v2 2/4] gnu-maintenance: KDE updater no longer relies on FTP access.

[Hartmut Goebel]

Fetch the ls-lR.bz2 file list for download.kde.org, convert it into a list of
file paths and cache the list.

* guix/gnu-maintenance.scm (%kde-file-list-uri): New variable.
  (download.kde.org-files): New procedure.
  (latest-kde-release): Change to use DOWNLOAD.KDE.ORG-FILES and search
  for files in this list.
---
 guix/gnu-maintenance.scm | 100 +++++++++++++++++++++++++++++++++++----
 1 file changed, 92 insertions(+), 8 deletions(-)

diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 8fce956c60..9ce06508a3 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org>
+;;; Copyright © 2019 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,6 +25,7 @@
   #:use-module (sxml simple)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
@@ -613,15 +615,97 @@ releases are on gnu.org."
 (define gnu-hosted?
   (url-prefix-predicate "mirror://gnu/"))
 
+(define %kde-file-list-uri
+  ;; URI of the file list (ls -lR format) for download.kde.org.
+  (string->uri "https://download.kde.org/ls-lR.bz2"))
+
+(define (download.kde.org-files)
+  ;;"Return the list of files available at download.kde.org."
+
+  (define (ls-lR-line->filename path line)
+    ;; remove mode, blocks, user, group, size, date, time and one space
+    (regexp-substitute
+     #f (string-match "^(\\S+\\s+){6}\\S+\\s" line) path 'post))
+
+  (define (canonicalize path)
+    (let* ((path (if (string-prefix? "/srv/archives/ftp/" path)
+                     (string-drop path (string-length "/srv/archives/ftp"))
+                     path))
+           (path (if (string-suffix? ":" path)
+                     (string-drop-right path 1)
+                     path))
+           (path (if (not (string-suffix? "/" path))
+                     (string-append path "/")
+                     path)))
+      path))
+
+  (define (write-cache input cache)
+    "Read bzipped ls-lR from INPUT, and write it as a list of file paths to
+CACHE."
+
+    (call-with-decompressed-port 'bzip2 input
+      (lambda (input)
+        (let loop_dirs ((files '()))
+          (let ((path (read-line input)))
+            (if
+             (or (eof-object? path) (string= path ""))
+             (write (reverse files) cache))
+            (let loop_entries ((path (canonicalize path))
+                               (files files))
+              (let ((line (read-line input)))
+                (cond
+                 ((eof-object? line)
+                  (write (reverse files) cache))
+                 ((string-prefix? "-" line)
+                  (loop_entries path
+                                (cons (ls-lR-line->filename path line) files)))
+                 ((not (string= line ""))
+                  (loop_entries path files))
+                 (#t (loop_dirs files))))))))))
+
+  (define (cache-miss uri)
+    (format (current-error-port) "fetching ~a...~%" (uri->string uri)))
+
+  (let* ((port (http-fetch/cached %kde-file-list-uri
+                                  #:ttl 3600
+                                  #:write-cache write-cache
+                                  #:cache-miss cache-miss))
+         (files (read port)))
+    (close-port port)
+    files))
+
 (define (latest-kde-release package)
-  "Return the latest release of PACKAGE, the name of an KDE.org package."
-  (let ((uri (string->uri (origin-uri (package-source package)))))
-    (false-if-ftp-error
-     (latest-ftp-release
-      (package-upstream-name package)
-      #:server "ftp.mirrorservice.org"
-      #:directory (string-append "/sites/ftp.kde.org/pub/kde/"
-                                 (dirname (dirname (uri-path uri))))))))
+  "Return the latest release of PACKAGE, a KDE package, or #f if it could not
+be determined."
+  (let* ((uri      (string->uri (origin-uri (package-source package))))
+         (directory  (dirname (dirname (uri-path uri))))
+         (name     (package-upstream-name package))
+         (files    (download.kde.org-files))
+         (relevant (filter (lambda (file)
+                             (and (string-prefix? directory file)
+                                  (release-file? name (basename file))))
+                           files)))
+    (match (sort relevant (lambda (file1 file2)
+                            (version>? (tarball-sans-extension
+                                        (basename file1))
+                                       (tarball-sans-extension
+                                        (basename file2)))))
+           ((and tarballs (reference _ ...))
+            (let* ((version  (tarball->version reference))
+                   (tarballs (filter (lambda (file)
+                                       (string=? (tarball-sans-extension
+                                                  (basename file))
+                                                 (tarball-sans-extension
+                                                  (basename reference))))
+                                     tarballs)))
+              (upstream-source
+               (package name)
+               (version version)
+               (urls (map (lambda (file)
+                            (string-append "mirror://kde/" file))
+                          tarballs)))))
+           (()
+            #f))))
 
 (define (latest-xorg-release package)
   "Return the latest release of PACKAGE, the name of an X.org package."
-- 
2.21.0

[bug#36919] [Patch v2 3/4] upstream: Move KDE updater into a separate module.

[Hartmut Goebel]

As it was done for (guix import gnome).

* guix/import/kde.scm: New file.
* Makefile.am (MODULES): Add it.
* guix/gnu-maintenance.scm (%kde-updater) (%kde-file-list-uri)
  (download.kde.org-files) (latest-kde-release): Remove.
---
 Makefile.am              |   1 +
 guix/gnu-maintenance.scm | 102 -------------------------
 guix/import/kde.scm      | 158 +++++++++++++++++++++++++++++++++++++++
 3 files changed, 159 insertions(+), 102 deletions(-)
 create mode 100644 guix/import/kde.scm

diff --git a/Makefile.am b/Makefile.am
index fa6bf8fe80..c8366c0421 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -218,6 +218,7 @@ MODULES =					\
   guix/import/gnu.scm				\
   guix/import/hackage.scm			\
   guix/import/json.scm				\
+  guix/import/kde.scm				\
   guix/import/launchpad.scm   			\
   guix/import/opam.scm				\
   guix/import/print.scm				\
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 9ce06508a3..ef067704ad 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -1,7 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org>
-;;; Copyright © 2019 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -25,7 +24,6 @@
   #:use-module (sxml simple)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 match)
-  #:use-module (ice-9 rdelim)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
@@ -64,7 +62,6 @@
 
             %gnu-updater
             %gnu-ftp-updater
-            %kde-updater
             %xorg-updater
             %kernel.org-updater))
 
@@ -615,98 +612,6 @@ releases are on gnu.org."
 (define gnu-hosted?
   (url-prefix-predicate "mirror://gnu/"))
 
-(define %kde-file-list-uri
-  ;; URI of the file list (ls -lR format) for download.kde.org.
-  (string->uri "https://download.kde.org/ls-lR.bz2"))
-
-(define (download.kde.org-files)
-  ;;"Return the list of files available at download.kde.org."
-
-  (define (ls-lR-line->filename path line)
-    ;; remove mode, blocks, user, group, size, date, time and one space
-    (regexp-substitute
-     #f (string-match "^(\\S+\\s+){6}\\S+\\s" line) path 'post))
-
-  (define (canonicalize path)
-    (let* ((path (if (string-prefix? "/srv/archives/ftp/" path)
-                     (string-drop path (string-length "/srv/archives/ftp"))
-                     path))
-           (path (if (string-suffix? ":" path)
-                     (string-drop-right path 1)
-                     path))
-           (path (if (not (string-suffix? "/" path))
-                     (string-append path "/")
-                     path)))
-      path))
-
-  (define (write-cache input cache)
-    "Read bzipped ls-lR from INPUT, and write it as a list of file paths to
-CACHE."
-
-    (call-with-decompressed-port 'bzip2 input
-      (lambda (input)
-        (let loop_dirs ((files '()))
-          (let ((path (read-line input)))
-            (if
-             (or (eof-object? path) (string= path ""))
-             (write (reverse files) cache))
-            (let loop_entries ((path (canonicalize path))
-                               (files files))
-              (let ((line (read-line input)))
-                (cond
-                 ((eof-object? line)
-                  (write (reverse files) cache))
-                 ((string-prefix? "-" line)
-                  (loop_entries path
-                                (cons (ls-lR-line->filename path line) files)))
-                 ((not (string= line ""))
-                  (loop_entries path files))
-                 (#t (loop_dirs files))))))))))
-
-  (define (cache-miss uri)
-    (format (current-error-port) "fetching ~a...~%" (uri->string uri)))
-
-  (let* ((port (http-fetch/cached %kde-file-list-uri
-                                  #:ttl 3600
-                                  #:write-cache write-cache
-                                  #:cache-miss cache-miss))
-         (files (read port)))
-    (close-port port)
-    files))
-
-(define (latest-kde-release package)
-  "Return the latest release of PACKAGE, a KDE package, or #f if it could not
-be determined."
-  (let* ((uri      (string->uri (origin-uri (package-source package))))
-         (directory  (dirname (dirname (uri-path uri))))
-         (name     (package-upstream-name package))
-         (files    (download.kde.org-files))
-         (relevant (filter (lambda (file)
-                             (and (string-prefix? directory file)
-                                  (release-file? name (basename file))))
-                           files)))
-    (match (sort relevant (lambda (file1 file2)
-                            (version>? (tarball-sans-extension
-                                        (basename file1))
-                                       (tarball-sans-extension
-                                        (basename file2)))))
-           ((and tarballs (reference _ ...))
-            (let* ((version  (tarball->version reference))
-                   (tarballs (filter (lambda (file)
-                                       (string=? (tarball-sans-extension
-                                                  (basename file))
-                                                 (tarball-sans-extension
-                                                  (basename reference))))
-                                     tarballs)))
-              (upstream-source
-               (package name)
-               (version version)
-               (urls (map (lambda (file)
-                            (string-append "mirror://kde/" file))
-                          tarballs)))))
-           (()
-            #f))))
-
 (define (latest-xorg-release package)
   "Return the latest release of PACKAGE, the name of an X.org package."
   (let ((uri (string->uri (origin-uri (package-source package)))))
@@ -754,13 +659,6 @@ be determined."
                 (pure-gnu-package? package))))
    (latest latest-release*)))
 
-(define %kde-updater
-  (upstream-updater
-    (name 'kde)
-    (description "Updater for KDE packages")
-    (pred (url-prefix-predicate "mirror://kde/"))
-    (latest latest-kde-release)))
-
 (define %xorg-updater
   (upstream-updater
    (name 'xorg)
diff --git a/guix/import/kde.scm b/guix/import/kde.scm
new file mode 100644
index 0000000000..927ecc8263
--- /dev/null
+++ b/guix/import/kde.scm
@@ -0,0 +1,158 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016 David Craven <david@craven.ch>
+;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019 Hartmut Goebel <h.goebel@crazy-compilers.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix import kde)
+  #:use-module (guix http-client)
+  #:use-module (guix memoization)
+  #:use-module (guix gnu-maintenance)
+  #:use-module (guix packages)
+  #:use-module (guix upstream)
+  #:use-module (guix utils)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 regex)
+  #:use-module (srfi srfi-11)
+  #:use-module (web uri)
+
+  #:export (%kde-updater))
+
+;;; Commentary:
+;;;
+;;; This package provides not an actual importer but simply an updater for
+;;; KDE packages.  It grabs available files from the 'ls-lR.bz2' file
+;;; available on download.kde.org.
+;;;
+;;; Code:
+
+(define (tarball->version tarball)
+  "Return the version TARBALL corresponds to.  TARBALL is a file name like
+\"coreutils-8.23.tar.xz\"."
+  (let-values (((name version)
+                (gnu-package-name->name+version
+                 (tarball-sans-extension tarball))))
+    version))
+
+(define %kde-file-list-uri
+  ;; URI of the file list (ls -lR format) for download.kde.org.
+  (string->uri "https://download.kde.org/ls-lR.bz2"))
+
+(define (download.kde.org-files)
+  ;;"Return the list of files available at download.kde.org."
+
+    (define (ls-lR-line->filename path line)
+      ;; Remove mode, blocks, user, group, size, date, time and one space,
+      ;; then prepend PATH
+      (regexp-substitute
+       #f (string-match "^(\\S+\\s+){6}\\S+\\s" line) path 'post))
+
+    (define (canonicalize path)
+      (let* ((path (if (string-prefix? "/srv/archives/ftp/" path)
+                       (string-drop path (string-length "/srv/archives/ftp"))
+                       path))
+             (path (if (string-suffix? ":" path)
+                       (string-drop-right path 1)
+                       path))
+             (path (if (not (string-suffix? "/" path))
+                       (string-append path "/")
+                       path)))
+        path))
+
+    (define (write-cache input cache)
+      "Read bzipped ls-lR from INPUT, and write it as a list of file paths to
+CACHE."
+      (call-with-decompressed-port 'bzip2 input
+        (lambda (input)
+          (let loop_dirs ((files '()))
+            ;; process a new directory block
+            (let ((path (read-line input)))
+              (if
+               (or (eof-object? path) (string= path ""))
+               (write (reverse files) cache)
+               (let loop_entries ((path (canonicalize path))
+                                  (files files))
+                 ;; process entries within the directory block
+                 (let ((line (read-line input)))
+                   (cond
+                    ((eof-object? line)
+                     (write (reverse files) cache))
+                    ((string-prefix? "-" line)
+                     ;; this is a file entry: prepend to FILES, then re-enter
+                     ;; the loop for remaining entries
+                     (loop_entries path
+                                   (cons (ls-lR-line->filename path line) files)
+                                   ))
+                    ((not (string= line ""))
+                     ;; this is a non-file entry: ignore it, just re-enter the
+                     ;; loop for remaining entries
+                     (loop_entries path files))
+                    ;; empty line: directory block end, re-enter the outer
+                    ;; loop for the next block
+                    (#t (loop_dirs files)))))))))))
+
+  (define (cache-miss uri)
+    (format (current-error-port) "fetching ~a...~%" (uri->string uri)))
+
+  (let* ((port (http-fetch/cached %kde-file-list-uri
+                                  #:ttl 3600
+                                  #:write-cache write-cache
+                                  #:cache-miss cache-miss))
+         (files (read port)))
+    (close-port port)
+    files))
+
+(define (latest-kde-release package)
+  "Return the latest release of PACKAGE, a KDE package, or #f if it could
+not be determined."
+  (let* ((uri      (string->uri (origin-uri (package-source package))))
+         (directory  (dirname (dirname (uri-path uri))))
+         (name     (package-upstream-name package))
+         (files    (download.kde.org-files))
+         (relevant (filter (lambda (file)
+                             (and (string-prefix? directory file)
+                                  (release-file? name (basename file))))
+                           files)))
+    (match (sort relevant (lambda (file1 file2)
+                            (version>? (tarball-sans-extension
+                                        (basename file1))
+                                       (tarball-sans-extension
+                                        (basename file2)))))
+           ((and tarballs (reference _ ...))
+            (let* ((version  (tarball->version reference))
+                   (tarballs (filter (lambda (file)
+                                       (string=? (tarball-sans-extension
+                                                  (basename file))
+                                                 (tarball-sans-extension
+                                                  (basename reference))))
+                                     tarballs)))
+              (upstream-source
+               (package name)
+               (version version)
+               (urls (map (lambda (file)
+                            (string-append "mirror://kde/" file))
+                          tarballs)))))
+           (()
+            #f))))
+
+(define %kde-updater
+  (upstream-updater
+    (name 'kde)
+    (description "Updater for KDE packages")
+    (pred (url-prefix-predicate "mirror://kde/"))
+    (latest latest-kde-release)))
-- 
2.21.0

[bug#36919] [Patch v2 4/4] import: KDE updater finds packages even in sub-directory.

[Hartmut Goebel]

Fixes <http://issues.guix.gnu.org/issue/30345> and
finally fixes <http://issues.guix.gnu.org/issue/25020>.

Formerly packages living in a path like
/stable/frameworks/5.60/portingAids/kross-5.60.0.tar.xz
have not been found.

* guix/import/kde.scm (uri->kde-path-pattern): New procedure.
  (latest-kde-release): Use pattern to search for file.
---
 guix/import/kde.scm | 36 ++++++++++++++++++++++++++++++++++--
 1 file changed, 34 insertions(+), 2 deletions(-)

diff --git a/guix/import/kde.scm b/guix/import/kde.scm
index 927ecc8263..6873418d62 100644
--- a/guix/import/kde.scm
+++ b/guix/import/kde.scm
@@ -117,15 +117,47 @@ CACHE."
     (close-port port)
     files))
 
+(define (uri->kde-path-pattern uri)
+  "Build a regexp from the package's URI suitable for matching the package
+path version-agnostic.
+
+Example:
+Input:
+   mirror://kde//stable/frameworks/5.55/portingAids/kross-5.55.0.zip
+Output:
+   //stable/frameworks/[^/]+/portingAids/
+"
+
+  (define version-regexp
+    ;; regexp for matching versions as used in the ld-lR file
+    (make-regexp
+     (string-join '("^([0-9]+\\.)+[0-9]+-?"   ;; 5.12.90, 4.2.0-preview
+                    "^[0-9]+$"                ;; 20031002
+                    ".*-([0-9]+\\.)+[0-9]+$") ;; kdepim-4.6.1
+                    "|")))
+
+  (define (version->pattern part)
+    ;; If a path element might be a version, replace it by a catch-all part
+    (if (regexp-exec version-regexp part)
+        "[^/]+"
+        part))
+
+  (let* ((path (uri-path uri))
+         (directory-parts (string-split (dirname path) #\/)))
+    (make-regexp
+     (string-append
+      (string-join (map version->pattern directory-parts) "/")
+      "/"))))
+
 (define (latest-kde-release package)
   "Return the latest release of PACKAGE, a KDE package, or #f if it could
 not be determined."
   (let* ((uri      (string->uri (origin-uri (package-source package))))
-         (directory  (dirname (dirname (uri-path uri))))
+         (path-rx  (uri->kde-path-pattern uri))
          (name     (package-upstream-name package))
          (files    (download.kde.org-files))
          (relevant (filter (lambda (file)
-                             (and (string-prefix? directory file)
+                             (and (regexp-exec path-rx file)
                                   (release-file? name (basename file))))
                            files)))
     (match (sort relevant (lambda (file1 file2)
-- 
2.21.0

[bug#36919] [Patch v2 0/4] Make the KDE updater find packages in subdirectories

[Ludovic Courtès]

Hello Hartmut,

Hartmut Goebel <h.goebel@crazy-compilers.com> skribis:

> Relevant changes:
>
> * Moved kde code into a separete module. THis is done *after* the first change
>   ("no longer relies on FTP access"9, since otherwise a lot of FTP-releated
>   identifiers would have had to be exported in gnu-maintenance.scm.
> * Using a custom write-cache to cache the evaluated file list, as suggested by
>   Ludo
> * Removed usage of 'set!'
> * Using named let instead of 'do'
>
>
> Hartmut Goebel (4):
>   guix: Rename and move sans-extension to tarball-sans-extension.
>   gnu-maintenance: KDE updater no longer relies on FTP access.
>   upstream: Move KDE updater into a separate module.
>   import: KDE updater finds packages even in sub-directory.

All looks good to me, thank you!

Ludo’.

bug#36919: [Patch v2 0/4] Make the KDE updater find packages in subdirectories

[Hartmut Goebel]

Pushed as 4eb69bf0d33810886ee118f38989cef696e4c868

Thanks for tutoring and for the review

-- 
Regards
Hartmut Goebel

| Hartmut Goebel          | h.goebel@crazy-compilers.com               |
| www.crazy-compilers.com | compilers which you thought are impossible |