Initial commit.

2025-06-30 16:15:39 +02:00 · 2025-06-30 16:15:39 +02:00 · 878d52ee27
commit 878d52ee27
26 changed files with 3341 additions and 0 deletions
--- a/ebuild/fetchers/raw.scm
+++ b/ebuild/fetchers/raw.scm
@ -0,0 +1,122 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; raw.scm
+;; Copyright (C) 2025 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 raw)
+  #:use-module (ebuild defs)
+  #:use-module (ebuild utils)
+  #:use-module (curl)
+  #:use-module (rx irregex)
+  #:use-module (ice-9 pretty-print)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 string-fun)
+  #:use-module (srfi srfi-1)
+  #:use-module (dql dql))
+
+(define-public fetch-raw
+  (lambda* (url extract-file extract-version asset-types #:key
+                (uri-prefix "")
+                (version-filter (lambda (version) #t))
+                (version-alter (lambda (version) version)))
+    "extract-file should extract the file name till the dot before the type."
+    (let ((curl-handle (curl-easy-init)))
+      (curl-easy-setopt curl-handle 'url url)
+      (curl-easy-setopt curl-handle 'useragent curl-useragent)
+      (let ((responce (curl-easy-perform curl-handle)))
+        (let ((releases (extract-file responce)))
+          (filter-map
+           (lambda (release)
+             (let ((version (version-alter (extract-version release))))
+               (if (version-filter version)
+                   (list (cons "version" version)
+                         (cons "assets"
+                               (map
+                                (lambda (type)
+                                  (list
+                                   (cons "uri"
+                                         (string-append
+                                          (if (string=? uri-prefix "")
+                                              (if (string-match
+                                                   "^(http://|https://|ftp://)"
+                                                   release)
+                                                  "" url)
+                                              uri-prefix)
+                                          release type))
+                                   (cons "name" (string-append release type))
+                                   (cons "type" type)))
+                                asset-types)))
+                   #f)))
+           releases))))))
+
+(define-public fetch-raw-html
+  (lambda* (url file-prefix
+                asset-types #:key
+                (uri-prefix "")
+                (version-filter (lambda (version) #t))
+                (version-alter (lambda (version) version))
+                (extract-version
+                 (lambda (file)
+                   (let ((my-match (irregex-search `(seq (+ num) "."
+                                                         (+ num) "."
+                                                         (+ num))
+                                                   file)))
+                     (if my-match
+                         (irregex-match-substring my-match)))))
+                (file-postfix (car asset-types)))
+    ""
+    (fetch-raw url
+               (lambda (responce)
+                 ;; Break up in lines, otherwise rx extremely expensive.
+                 (filter-map
+                  (lambda (line)
+                    (let ((rx-match
+                           (irregex-search
+                            `(seq (look-behind "<a href=\"")
+                                  ,file-prefix
+                                  (seq (+ num) "." (+ num) "." (+ num))
+                                  "."
+                                  (look-ahead ,(string-append file-postfix
+                                                              "\">")))
+                            line)))
+                      (if rx-match
+                          (irregex-match-substring rx-match)
+                          #f)))
+                  (string-split responce #\newline)))
+               extract-version
+               asset-types
+               #:uri-prefix uri-prefix
+               #:version-filter version-filter
+               #:version-alter version-alter)))
+
+(define-public fetch-raw-release
+  (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)))
+           (uri (assoc-ref my-file-data "uri"))
+           (name (assoc-ref my-file-data "name"))
+           (file-path (string-append (assoc-ref release 'cache-path)
+                                     "/"
+                                     name)))
+      (mkpath (assoc-ref release 'cache-path))
+      (if (not (access? file-path F_OK))
+          (system* "/usr/bin/wget" "-O" file-path uri))
+      file-path)))