Re: Why linux-libre source code is not in sources.json

[zimoun <zimon.toutoune@gmail.com>]

Hi,

On Thu, 9 Sept 2021 at 11:51, Maxime Devos <maximedevos@telenet.be> wrote:

> > where ’make-linux-libre-source’ returns a ’computed-origin-method’.  And
> > the ’origin-uri’ of ’linux-libre-5.14-pristine-source’ is a ’gexp’.
> > Then inside this ’gexp’, you can read the ’%upstream-linux-source’ URL:
> >
> > --8<---------------cut here---------------start------------->8---
> > #<gexp-input native
> >  #<origin
> >   #"mirror://kernel.org/linux/kernel/v5.x/linux-5.13.14.tar.xz"
> >   #<content-hash sha256:06lbjsbr86qa8yai5gfclbfxvcqsw33kxj9b4r93hh6z1wajmx82>
> > --8<---------------cut here---------------end--------------->8---
> >
> > and I do not know if it is possible to extract such thing.
>
> To extract the <origin> from the <gexp-input>, use gexp-input-thing.
> To extract the <gexp-input> from the <gexp>, use the unexported
> gexp-references.

Thanks!  It does the job. :-)

I will fix sources.json if no one beats me.

With the (ugly) snippet below,  I get almost the linux-libre, I guess.
The question is now how does SWH ingest the script with the URL:

<https://linux-libre.fsfla.org/pub/linux-libre/releases/5.13.14-gnu1/deblob-5.13>

Another story. :-)

Cheers,
simon


--8<---------------cut here---------------start------------->8---
$ guix repl /tmp/linux.scm | grep linux-libre
(mirror://kernel.org/linux/kernel/v5.x/linux-5.13.14.tar.xz
https://linux-libre.fsfla.org/pub/linux-libre/releases/5.13.14-gnu1/deblob-check
https://linux-libre.fsfla.org/pub/linux-libre/releases/5.13.14-gnu1/deblob-5.13)
(mirror://kernel.org/linux/kernel/v5.x/linux-5.13.14.tar.xz
https://linux-libre.fsfla.org/pub/linux-libre/releases/5.13.14-gnu1/deblob-check
https://linux-libre.fsfla.org/pub/linux-libre/releases/5.13.14-gnu1/deblob-5.13)
(mirror://kernel.org/linux/kernel/v4.x/linux-4.4.283.tar.xz
https://linux-libre.fsfla.org/pub/linux-libre/releases/4.4.283-gnu1/deblob-check
https://linux-libre.fsfla.org/pub/linux-libre/releases/4.4.283-gnu1/deblob-4.4)
(mirror://kernel.org/linux/kernel/v4.x/linux-4.19.206.tar.xz
https://linux-libre.fsfla.org/pub/linux-libre/releases/4.19.206-gnu1/deblob-check
https://linux-libre.fsfla.org/pub/linux-libre/releases/4.19.206-gnu1/deblob-4.19)

[...]

(https://linux-libre.fsfla.org/pub/linux-libre/releases/5.4.20-gnu/linux-libre-5.4.20-gnu.tar.xz
ftp://alpha.gnu.org/gnu/guix/mirror/linux-libre-5.4.20-gnu.tar.xz
mirror://gnu/linux-libre/5.4.20-gnu/linux-libre-5.4.20-gnu.tar.xz)
(mirror://kernel.org/linux/kernel/v4.x/linux-4.14.246.tar.xz
https://linux-libre.fsfla.org/pub/linux-libre/releases/4.14.246-gnu1/deblob-check
https://linux-libre.fsfla.org/pub/linux-libre/releases/4.14.246-gnu1/deblob-4.14)
(https://linux-libre.fsfla.org/pub/linux-libre/releases/5.4.20-gnu/linux-libre-5.4.20-gnu.tar.xz
ftp://alpha.gnu.org/gnu/guix/mirror/linux-libre-5.4.20-gnu.tar.xz
mirror://gnu/linux-libre/5.4.20-gnu/linux-libre-5.4.20-gnu.tar.xz)
--8<---------------cut here---------------end--------------->8---


--8<---------------cut here---------------start------------->8---
(use-modules (guix packages)
             (guix gexp)
             (gnu packages)
             (gnu packages linux)
             (srfi srfi-1)
             (ice-9 match))

(define gexp-references (@@ (guix gexp) gexp-references))

(define (thing->string thing)
  (match thing
    ((? gexp-input? g)
     (match (gexp-input-thing g)
       ((? origin? o)
        (origin-uri o))
       (_ #f)))
    (_ #f)))

(define (get-uri pkg)
  (match (package-source pkg)
    ((? origin? o)
     (match (origin-uri o)
       ((? string? s)
        (list s))
       ((? list? lst)
        lst)
       ((? promise? prom)
        (match (force prom)
          ((? gexp? g)
           (filter (lambda (x) x)
                   (delete-duplicates
                    (map thing->string
                         (gexp-references g)))))
          (_
           (list #f))))
       (_
        (list #f))))
    (_ #f)))

(define all-packages
  (sort
   (fold-packages (lambda (package lst)
                    (if (or (package-superseded package)
                            (package-replacement package))
                        lst
                        (cons package lst)))
                  '())
   (lambda (p1 p2)
     (string<? (package-name p1)
               (package-name p2)))))

(map (lambda (p)
       (format #t "~a~%" (get-uri p)))
     all-packages)
--8<---------------cut here---------------end--------------->8---