cor/ebuild-autogen
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

V0.0.3 Nodejs support.

Browse source
This commit is contained in:
Cor Legemaat 2026-03-30 07:00:06 +02:00
commit 54f494163a
17 changed files with 1871 additions and 484 deletions
Download patch file Download diff file Expand all files Collapse all files

4
ebuild/fetchers/Makefile.am
View file

@ -1,6 +1,6 @@
################################################################################
# Makefile.am
# Copyright (C) 2025 Cor Legemaat <cor@cor.za.net>
# Copyright (C) 2025, 2026 Cor Legemaat <cor@cor.za.net>
#
# This file is part of ebuild-autogen: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by the
@ -22,6 +22,7 @@ SOURCES = \
forgejo.scm \
github.scm \
pypi.scm \
npmjs.scm \
raw.scm
# Manual dependencys.
@ -29,6 +30,7 @@ ebuild.go: ../version.scm
forgejo.go: ../version.scm
github.go: ../version.scm
pypi.go: ../version.scm
npmjs.go: ../version.scm
raw.scm: ../version.scm
GOBJECTS = $(SOURCES:%.scm=%.go)

14
ebuild/fetchers/forgejo.scm
View file

@ -1,6 +1,6 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; forgejo.scm
;; Copyright (C) 2025 Cor Legemaat <cor@cor.za.net>
;; Copyright (C) 2025, 2026 Cor Legemaat <cor@cor.za.net>
;;
;; This file is part of ebuild-autogen: you can redistribute it and/or modify it
;; under the terms of the GNU Affero General Public License as published by the
@ -17,6 +17,7 @@
(define-module (ebuild fetchers forgejo)
#:use-module (ebuild defs)
#:use-module (ebuild fetchers raw)
#:use-module (ebuild semver)
#:use-module (ebuild utils)
#:use-module (curl)
#:use-module (json)
@ -58,11 +59,12 @@
(if responce
(begin (check-forgejo-errors responce)
(let ((scm-responce (json-string->scm responce)))
(if (< 100 (vector-length scm-responce))
(vector-append (fetch-forgejo-pages url
(if (= 100 (vector-length scm-responce))
(vector-append scm-responce
(fetch-forgejo-pages url
auth-token
verbosity
(+1 page)))
(1+ page)))
(begin (if (>= verbosity verbosity-info)
(pretty-print scm-responce))
scm-responce))))
@ -143,6 +145,8 @@
(set! scm (json-string->scm json))
(assoc-set! release "version" version-final)
(append release
(list (cons "version-values"
(semver->comps version-final)))
(list (cons "repo-user" user))
(list (cons "repo-repo" repo))
;;TODO append this with list of custom assets.
@ -178,6 +182,8 @@
(base-asset-url (string-append host "/" user "/" repo)))
(assoc-set! tag "version" version-final)
(append tag
(list (cons "version-values"
(semver->comps version-final)))
(list (cons "repo-user" user))
(list (cons "repo-name" repo))
(list

15
ebuild/fetchers/github.scm
View file

@ -1,6 +1,6 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; github.scm
;; Copyright (C) 2025 Cor Legemaat <cor@cor.za.net>
;; Copyright (C) 2025, 2026 Cor Legemaat <cor@cor.za.net>
;;
;; This file is part of ebuild-autogen: you can redistribute it and/or modify it
;; under the terms of the GNU Affero General Public License as published by the
@ -18,6 +18,7 @@
#:use-module (ebuild defs)
#:use-module (ebuild fetchers raw)
#:use-module (ebuild utils)
#:use-module (ebuild semver)
#:use-module (curl)
#:use-module (json)
#:use-module (ice-9 pretty-print)
@ -63,10 +64,12 @@
(if responce
(begin (check-github-errors responce)
(let ((scm-responce (json-string->scm responce)))
(if (< 100 (vector-length scm-responce))
(vector-append (fetch-github-pages url
(if (= 100 (vector-length scm-responce))
(vector-append scm-responce
(fetch-github-pages url
token
verbosity
(+1 page)))
(1+ page)))
(begin (if (>= verbosity verbosity-info)
(pretty-print scm-responce))
scm-responce))))
@ -156,6 +159,8 @@
(set! sha7 (string-take sha 7))
(assoc-set! release "version" version-final)
(append release
(list (cons "version-values"
(semver->comps version-final)))
(list (cons "sha" sha))
(list (cons "github-user" user))
(list (cons "github-repo" repo))
@ -200,6 +205,8 @@
repo)))
(assoc-set! tag "version" version-final)
(append tag
(list (cons "version-values"
(semver->comps version-final)))
(list (cons "github-user" user))
(list (cons "github-repo" repo))
(list (cons "sha7" sha7))

247
ebuild/fetchers/npmjs.scm Normal file
View file

@ -0,0 +1,247 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; npmjs.scm
;; Copyright (C) 2025, 2026 Cor Legemaat <cor@cor.za.net>
;;
;; This file is part of ebuild-autogen: you can redistribute it and/or modify it
;; under the terms of the GNU Affero General Public License as published by the
;; Free Software Foundation, version 3 of the License.
;;
;; ebuild-autogen 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
;; ebuild-autogen. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-module (ebuild fetchers npmjs)
#:use-module (ebuild defs)
#:use-module (ebuild fetchers raw)
#:use-module (ebuild utils)
#:use-module (ebuild pkt-map)
#:use-module (ebuild semver)
#:use-module (curl)
#:use-module (json)
#:use-module (ice-9 pretty-print)
#:use-module (oop goops)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-43)
#:use-module (rx irregex)
#:use-module (dql dql))
(define fetch-npmjs-pkg
(lambda (pkg retries display-data)
""
(let loop ((try 1))
(let ((curl-handle (curl-easy-init)))
;; Set the url to fetch.
(curl-easy-setopt curl-handle
'url
(string-append "https://registry.npmjs.org/"
pkg
"/"))
;; Set my user agent.
(curl-easy-setopt curl-handle 'useragent curl-useragent)
;; Set Connection Timeout in seconds
(curl-easy-setopt curl-handle 'connecttimeout 5)
;; Kill on a stalled connection.
(curl-easy-setopt curl-handle 'low-speed-limit 120)
(curl-easy-setopt curl-handle 'low-speed-time 12)
(let* ((responce (curl-easy-perform curl-handle)))
(curl-easy-cleanup curl-handle)
(cond ((string? responce)
(let ((scm-responce (json-string->scm responce)))
(begin (if display-data
(pretty-print scm-responce))
scm-responce)))
((<= try retries)
(sleep 10)
(loop (1+ try)))
(else (error (string-append "npmjs fetch failed with error "
(curl-error-string)
"\n")))))))))
(define extract-deps
(lambda (deps)
(append-map
(lambda (dep)
(let* ((alias (car dep))
(pkg-match
(irregex-search '(seq (look-behind (seq "npm:"))
(? "@")
(look-ahead (seq "@"
(? (or "^" "~" "<" ">"
"<=" ">=" "*"
"=" "=="))
(? space)
(+ num))))
(cdr dep)))
(alt-slot-match
(irregex-search '(seq (look-behind (or bos "@" space)
(? (or "^" ">=" "<=" ">" "<")))
(* num)
(? "." (+ num)) ;; bugged spec...
(look-ahead (seq "." (or "*" "x"))))
(cdr dep)))
(alt-sub-slot-match
(irregex-search '(seq (look-behind (or bos "@" space)
(? (or "~" ">=" "<=" ">" "<")))
(* num) "." (+ num)
(look-ahead (seq "." (or "*" "x"))))
(cdr dep)))
(vers-match
(cond (alt-slot-match
(list (string-append "^"
(irregex-match-substring
alt-slot-match))))
(alt-sub-slot-match
(list (string-append "~"
(irregex-match-substring
alt-sub-slot-match))))
(else (irregex-extract
'(seq (look-behind (or bos "@" space))
(? (or "^" "~" "<" ">" "<=" ">=" "*" "=" "=="))
(? space)
(* num)
(* (or (seq "." (+ num))
(seq "-" (+ alphanum))))
(look-ahead (or (seq "+"
(+ (or alphanum "-"))
eos)
(seq (+ space) eos)
eos)))
(cdr dep))))))
(if (or (null? vers-match)
(every (lambda (answ)
(string=? answ ""))
vers-match))
(set! vers-match (list "*")))
(map (lambda (vers)
(if (string=? vers "")
'()
(list (cons "alias" alias)
(cons "pkg" (if pkg-match
(irregex-match-substring pkg-match)
alias))
(cons "version" vers))))
vers-match)))
deps)))
(define-public fetch-npmjs
(lambda* (parms #:key
(npm-name (if (assoc-ref parms 'npm-name)
(assoc-ref parms 'npm-name)
(assoc-ref parms 'name)))
(file-types (list ".tgz"))
(version-filter (lambda (version)
(semver->irregex-match version)))
(version-alter (lambda (version) version))
(version-values (lambda (version)
(semver->comps version)))
(dep-alter (lambda (dep) dep))
(display-data #f))
""
(let* ((data (fetch-npmjs-pkg npm-name
(assoc-ref parms 'curl-retries)
display-data))
(versions (assoc-ref data "versions"))
(pkt-map-db (pkt-map-load (assoc-ref parms 'repo) "nodejs")))
;;(display "pkt-map-db-pre:") (newline)
;;(pretty-print pkt-map-db)
(set! pkt-map-db
(pkt-map-set pkt-map-db
npm-name
(assoc-ref parms 'category)
(assoc-ref parms 'name)))
;;(display "pkt-map-db-post:") (newline)
;;(pretty-print pkt-map-db)
(pkt-map-write pkt-map-db
(assoc-ref parms 'repo)
"nodejs")
(filter-map
(lambda (version)
(let* ((my-data (car ((dql (select (parm "version")
(parm-as "sha256" "dist" "shasum")
(parm-as "uri" "dist" "tarball")
(parm-as "node" "_nodeVersion")
(parm-as "npm" "_npmVersion")
(parm "dependencies")
(parm "license")
(parm "homepage")
(parm "description"))
;;#:print-query npmjs-data
)
(cdr version))))
(version-match (version-filter (assoc-ref my-data
"version"))))
;; (display "my-data:") (newline)
;; (pretty-print my-data)
(if (version-filter (assoc-ref my-data "version"))
(append
(list (cons "version"
(version-alter (assoc-ref my-data
"version"))))
(list (cons "version-values"
(semver->comps (assoc-ref my-data
"version")
#:vers-match version-match)))
(if (assoc-ref my-data "node")
(list (assoc "node" my-data))
'())
(if (assoc-ref my-data "npm")
(list (assoc "npm" my-data))
'())
(list (cons "npm-name" npm-name))
(let ((license (if (list? (assoc-ref my-data "license"))
(assoc-ref (assoc-ref my-data "license")
"type")
(assoc-ref my-data "license"))))
(cond
((not license) '())
((string=? license "UNLICENSED")
(list (cons "license" "Unlicense")))
((string=? license "BSD-3-Clause")
(list (cons "license" "BSD")))
((string=? license "BSD-2-Clause")
(list (cons "license" "BSD-2")))
((string=? license "Python-2.0")
(list (cons "license" "PYTHON")))
(else (list (cons "license" license)))))
(if (assoc-ref my-data "homepage")
(list (assoc "homepage" my-data))
'())
(if (assoc-ref my-data "description")
(list (cons "description"
(irregex-replace/all
`(or #\` #\")
(assoc-ref my-data "description")
"'")))
'())
(if (and (assoc-ref my-data "dependencies")
(not (null? (assoc-ref my-data "dependencies"))))
(list (cons "dependencies"
(extract-deps (filter-map
(lambda (dep)
(dep-alter dep))
(assoc-ref my-data
"dependencies")))))
(list))
(list
(cons "assets"
(list
(append (list (assoc "sha256" my-data))
(list (assoc "uri" my-data))
(list (cons "type" ".tgz"))
(list (cons "name"
(string-append
"npm-"
(assoc-ref parms 'name)
"-"
(assoc-ref my-data "version")
".tgz"))))))))
#f)))
versions))))

50
ebuild/fetchers/pypi.scm
View file

@ -1,6 +1,6 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; pypi.scm
;; Copyright (C) 2025 Cor Legemaat <cor@cor.za.net>
;; Copyright (C) 2025, 2026 Cor Legemaat <cor@cor.za.net>
;;
;; This file is part of ebuild-autogen: you can redistribute it and/or modify it
;; under the terms of the GNU Affero General Public License as published by the
@ -17,6 +17,7 @@
(define-module (ebuild fetchers pypi)
#:use-module (ebuild defs)
#:use-module (ebuild fetchers raw)
#:use-module (ebuild semver)
#:use-module (ebuild utils)
#:use-module (curl)
#:use-module (json)
@ -61,28 +62,32 @@
(let* ((data (fetch-pypi-pkg pypi-name display-data))
(versions (vector->list (assoc-ref data "versions")))
(files (assoc-ref data "files")))
(map (lambda (version)
(let ((upload-date (car ((dql (select (filter (where (lambda (file-name)
(if (string? file-name)
(string-contains file-name
(string-append "-"
version
(car file-types)))
#f))
"filename"))
(parm-as "date" "upload-time")))
files))))
(filter-map
(lambda (version)
(if (semver->irregex-match version)
(let ((upload-date ((dql (select (filter (where (lambda (file-name)
(if (string? file-name)
(string-contains file-name
(string-append "-"
version
(car file-types)))
#f))
"filename"))
(parm-as "date" "upload-time")))
files)))
(if (nil? upload-date)
(if (>= (assoc-ref parms 'verbosity)
verbosity-error)
(begin (display "Upload file \"")
(display (string-append "-"
version
(car file-types)))
(display "\" not found, skipping release!")
(newline)))
(begin (if (>= (assoc-ref parms 'verbosity)
verbosity-error)
(begin (display "Upload file for version \"")
(display version)
(display "\" and type \"")
(display (car file-types))
(display "\" not found, skipping release!")
(newline)))
#f)
(list (cons "version" version)
(car upload-date)
(cons "version-values" (semver->comps version))
(car (car upload-date))
(cons "assets"
(map (lambda (type)
(append (car ((dql (select (filter (where (lambda (file-name)
@ -98,5 +103,6 @@
(parm "hashes" "sha256")))
files))
(list (cons "type" type))))
file-types))))))
file-types)))))
#f))
versions))))

17
ebuild/fetchers/raw.scm
View file

@ -1,6 +1,6 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; raw.scm
;; Copyright (C) 2025 Cor Legemaat <cor@cor.za.net>
;; Copyright (C) 2025, 2026 Cor Legemaat <cor@cor.za.net>
;;
;; This file is part of ebuild-autogen: you can redistribute it and/or modify it
;; under the terms of the GNU Affero General Public License as published by the
@ -17,6 +17,7 @@
(define-module (ebuild fetchers raw)
#:use-module (ebuild defs)
#:use-module (ebuild utils)
#:use-module (ebuild semver)
#:use-module (curl)
#:use-module (rx irregex)
#:use-module (ice-9 pretty-print)
@ -41,6 +42,7 @@
(let ((version (version-alter (extract-version release))))
(if (version-filter version)
(list (cons "version" version)
(cons "version-values" (semver->comps version))
(cons "assets"
(map
(lambda (type)
@ -104,13 +106,12 @@
(lambda (release type)
""
(let* ((my-file-data
(car ((dql (select (filter (select (parm-val "assets"))
(where (lambda (x)
(string=? x type))
"type"))
(parm "uri")
(parm "name")))
release)))
(car ((dql (select (filter (where (lambda (x)
(string=? x type))
"type"))
(parm "uri")
(parm "name")))
(assoc-ref release "assets"))))
(uri (assoc-ref my-file-data "uri"))
(name (assoc-ref my-file-data "name"))
(file-path (string-append (assoc-ref release 'cache-path)