;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; repo.scm ;; Copyright (C) 2025 Cor Legemaat ;; ;; 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 . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define-module (ebuild repo) #:use-module (ebuild defs) #:use-module (ebuild utils) #:use-module (ice-9 exceptions) #:use-module (ice-9 ftw) #:use-module (srfi srfi-1) #:use-module (git bindings) #:use-module (git repository) #:use-module (rx irregex)) ;; Required initialization call. (libgit2-init!) (define-public repo-root-for (lambda (path verbosity) (let ((repo-orig (with-exception-handler (lambda (exception) (display exception) (newline) (display "error: Failed to find the repository root for \"") (display path) (display "\", ebuild-autogen is designed to work with ") (display "portage overlay repositories in git!") (newline) (display "If you are testing and don't have a git repository ") (display "yet for your overlay, make it one by running ") (display "'git init' in the root of the repository.") (newline)) (lambda () (repository-discover path))))) (let ((repo-root (dirname repo-orig))) (if (>= verbosity verbosity-notice) (begin (display "Using repository: ") (display repo-root) (newline))) (if (not (file-exists? (string-append repo-root "/autogen/"))) (raise-exception (make-exception (make-external-error) (make-exception-with-message "Can't find the \"autogen\" folder in repository root") (make-exception-with-irritants repo-root)))) repo-root)))) ;;(repo-root-for "/home/cor/Projects/portage-overlay" verbosity-notice) (define-public repo-update-src (lambda () (display "Willing to update src subtree...") (newline) #t)) (define-public repo-push-master (lambda () (display "Willing to push updates to master...") (newline) #t)) (define-public test-symlink (lambda (repo src dst verbosity) "" (let ((port (open-file repo "r"))) (if (false-if-exception (statat port src AT_SYMLINK_NOFOLLOW)) ;;Check if src is a symlink. (if (eq? (stat:type (statat port src AT_SYMLINK_NOFOLLOW)) 'symlink) (if (string=? (readlink (string-append repo "/" src)) dst) (if (>= verbosity verbosity-notice) (begin (display "Symlink \"") (display src) (display "\" ok.") (newline))) (if (>= verbosity verbosity-critical) (begin (display "warning: symlink from \"") (display src) (display "\" not pointing to \"") (display dst) (display "\" but to \"") (display (readlink (string-append repo "/" src))) (display "\" and might deliver unexpected results!") (newline)))) (if (>= verbosity verbosity-critical) (begin (display "warning: \"") (display src) (display "\" not a symbolic link and won't ") (display "represent autogen source data!") (newline)))) (begin (symlinkat port dst src) (if (>= verbosity verbosity-warn) (begin (display "Symlink \"") (display src) (display "\" created.") (newline))))) (close-port port)))) (define-public folder-list (lambda (path ignore-meta) "" ;;(display "path=\"") (display path) (display "\"") (newline) (filter-map (lambda (entry) (if (eq? 'directory (stat:type (stat (string-append path "/" entry)))) (if (and ignore-meta (or (string=? entry "metadata") (string=? entry "profiles"))) #f (if (char=? (car (string->list entry)) #\.) #f entry)) #f)) (scandir path)))) (define-public build-pkg-list (lambda (repo folder in-autogen) (let* ((file-seperator (car (string->list file-name-separator-string))) (repo-list (string-split repo file-seperator)) (repo-path-len (length repo-list)) (fpl (let ((folder-list (string-split folder file-seperator))) (if in-autogen ;; In autogen folder, aka the source pkgs. (if (> (length folder-list) repo-path-len) (if (string=? (car (take-right folder-list (- (length folder-list) repo-path-len))) "autogen") folder-list (append repo-list (list "autogen") (take-right folder-list (- (length folder-list) repo-path-len)))) (append folder-list (list "autogen"))) ;; Outside autogen folder, the generated pkgs. (if (> (length folder-list) repo-path-len) (if (string=? (car (take-right folder-list (- (length folder-list) repo-path-len))) "autogen") (append repo-list (take-right folder-list (- (length folder-list) (1+ repo-path-len)))) folder-list) folder-list)))) (depth (- (length fpl) repo-path-len (if in-autogen 1 0)))) ;;(display "fpl=\"") (display fpl) (display "\"") (newline) ;;(display "folder-list:") (display (folder-list (string-join fpl "/") #t)) (newline) (cond ((= depth 2) (list (list (cons 'category (first (take-right fpl 2))) (cons 'name (last fpl))))) ((= depth 1) (map (lambda (pkg) (list (cons 'category (last fpl)) (cons 'name pkg))) (folder-list (string-join fpl file-name-separator-string) #t))) ((= depth 0) (if (null? (folder-list (string-join fpl file-name-separator-string) #t)) (list (list)) (append-map (lambda (cat) (map (lambda (pkg) (list (cons 'category cat) (cons 'name pkg))) (folder-list (string-join (append fpl (list cat)) file-name-separator-string) #f))) (folder-list (string-join fpl file-name-separator-string) #t)))) (else ""))))) (define-public setup-pkg (lambda (parms) "" (let ((src-path (string-join (list (assoc-ref parms 'repo) "autogen" (assoc-ref parms 'category) (assoc-ref parms 'name)) file-name-separator-string)) (dst-path (string-join (list (assoc-ref parms 'repo) (assoc-ref parms 'category) (assoc-ref parms 'name)) file-name-separator-string))) ;;Check folder exists. (display "SRC-path=") (display src-path) (newline) (if (file-exists? dst-path) (if (>= (assoc-ref parms 'verbosity)) (begin (display "Folder for ") (display (assoc-ref parms 'category)) (display "/") (display (assoc-ref parms 'name)) (display " already exist.") (newline))) (mkpath dst-path)) ;;symlink each ebuild and the files folder. (for-each (lambda (file) (test-symlink (assoc-ref parms 'repo) (string-join (list dst-path file) file-name-separator-string) (string-join (list src-path file) file-name-separator-string) (assoc-ref parms 'verbosity))) (filter-map (lambda (file) (if (irregex-search '(or (seq bos "files" eos) (seq ".ebuild" eos )) file) file #f)) (scandir src-path))))))