From 10f16b0b3cf47931db5c9607b95872f477550422 Mon Sep 17 00:00:00 2001 Message-Id: <10f16b0b3cf47931db5c9607b95872f477550422.1693350103.git.dannym@scratchpost.org> From: Danny Milosavljevic Date: Wed, 30 Aug 2023 00:50:00 +0200 Subject: [PATCH] guix: scripts: Add "contrib" script. * guix/scripts/contrib.scm: New file. * guix/scripts/edit.scm (spawn-editor): Mention new command "guix contrib" if applicable. * manifest.scm: New file. * doc/guix.texi (Invoking guix contrib): New node. --- doc/guix.texi | 17 +++ guix/scripts/contrib.scm | 266 +++++++++++++++++++++++++++++++++++++++ guix/scripts/edit.scm | 53 ++++---- manifest.scm | 1 + 4 files changed, 316 insertions(+), 21 deletions(-) create mode 100644 guix/scripts/contrib.scm create mode 100644 manifest.scm diff --git a/doc/guix.texi b/doc/guix.texi index f82bb99069..c626a5b8ba 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -327,6 +327,7 @@ Top * Invoking guix build:: Building packages from the command line. * Invoking guix edit:: Editing package definitions. +* Invoking guix contrib:: Contributing changes to Guix. * Invoking guix download:: Downloading a file and printing its hash. * Invoking guix hash:: Computing the cryptographic hash of a file. * Invoking guix import:: Importing package definitions. @@ -13773,6 +13774,22 @@ Invoking guix edit @var{directory}}) allows you to add @var{directory} to the front of the package module search path and so make your own packages visible. +@node Invoking guix contrib +@section Invoking @command{guix contrib} +The @command{guix contrib edit} command allows new contributors to easily +get started in contributing to guix. + +First, if @command{guix edit} ended up with a file in the store +(which isn't editable), then guix will give a hint to use +@command{guix contrib edit} instead. + +@command{guix contrib edit} will automatically check out Guix source code +from version control, build it, optionally set up git in order to send email +and generally prepare a contributors' machine. Then it will give a hint +to use @command {./pre-inst-env guix edit} in order to actually edit +the file inside that new source code checkout of guix. It will also give +a hint on how to send the finished changes to us. + @node Invoking guix download @section Invoking @command{guix download} diff --git a/guix/scripts/contrib.scm b/guix/scripts/contrib.scm new file mode 100644 index 0000000000..3c95293305 --- /dev/null +++ b/guix/scripts/contrib.scm @@ -0,0 +1,266 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021-2023 Ludovic Courtès +;;; Copyright © 2023 Danny Milosavljevic +;;; +;;; 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 . + +(define-module (guix scripts contrib) + #:use-module (guix ui) + #:use-module (guix diagnostics) ; #:select (location leave report-error) + #:use-module (guix scripts environment) + #:autoload (guix scripts build) (show-build-options-help + show-native-build-options-help) + #:autoload (guix transformations) (options->transformation + transformation-option-key? + show-transformation-options-help) + #:use-module (guix scripts) + #:use-module (guix git) + #:use-module (guix build utils) + #:use-module (guix packages) + #:use-module (guix profiles) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-37) + #:use-module (srfi srfi-71) + #:use-module (ice-9 match) + #:use-module (ice-9 popen) + #:use-module (ice-9 textual-ports) + #:autoload (ice-9 rdelim) (read-line) + #:autoload (guix base32) (bytevector->base32-string) + #:autoload (rnrs bytevectors) (string->utf8) + #:autoload (guix utils) (config-directory cache-directory) + #:autoload (guix describe) (current-channels) + #:autoload (guix channels) (channel-commit) + #:autoload (gcrypt hash) (sha256) + #:use-module ((guix build utils) #:select (mkdir-p)) + #:use-module (guix cache) + #:use-module ((ice-9 ftw) #:select (scandir)) + #:autoload (ice-9 pretty-print) (pretty-print) + #:autoload (gnu packages) (cache-is-authoritative? + package-unique-version-prefix + specification->package + specification->package+output + specifications->manifest) + #:export (guix-contrib)) + +(define (show-help) + (display (G_ "Usage: guix contrib edit PACKAGES... +Create/update a development environment for guix and open a text editor with +PACKAGES inside it.\n")) + (newline) + + ;; These two options differ from 'guix environment'. + + (display (G_ " + -h, --help display this help and exit")) + (display (G_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +;;; FIXME: + +(define (tag-package-arg opts arg) + "Return a two-element list with the form (TAG ARG) that tags ARG with either +'ad-hoc' in OPTS has the 'ad-hoc?' key set to #t, or 'inputs' otherwise." + (if (assoc-ref opts 'ad-hoc?) + `(ad-hoc-package ,arg) + `(package ,arg))) + +(define (ensure-ad-hoc alist) + (if (assq-ref alist 'ad-hoc?) + alist + `((ad-hoc? . #t) ,@alist))) + +(define (wrapped-option opt) + "Wrap OPT, a SRFI-37 option, such that its processor always adds the +'ad-hoc?' flag to the resulting alist." + (option (option-names opt) + (option-required-arg? opt) + (option-optional-arg? opt) + (compose ensure-ad-hoc (option-processor opt)))) + +(define %options + ;; Specification of the command-line options. + (let ((to-remove '("ad-hoc" "inherit" "load" "help" "version"))) + (append + (list (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix contrib")))) + (filter-map (lambda (opt) + (and (not (any (lambda (name) + (member name to-remove)) + (option-names opt))) + (wrapped-option opt))) + %environment-options)))) + +(define %default-options + `()) + +(define (parse-args args) + "Parse the list of command line arguments ARGS." + (define (handle-argument arg result) + (alist-cons 'package (tag-package-arg result arg) + (ensure-ad-hoc result))) + + ;; The '--' token is used to separate the command to run from the rest of + ;; the operands. + (let ((args command (break (cut string=? "--" <>) args))) + (parse-command-line args %options (list %default-options)))) + +(define (invoke-and-read . args) + "Invoke ARGS and read its stdout into a string" + (let* ((pipe (apply open-pipe* OPEN_READ args)) + (result (string-trim-right (get-string-all pipe))) + (close-pipe pipe)) + result)) + +(define (ensure-git-setting name default-value) + (let ((current-value (invoke-and-read "git" "config" "--global" name))) + (format #t "Current setting of ~s is ~s~%" name current-value) + (let ((default-value (if (string=? current-value "") default-value current-value))) + (format #t "What value do you want for git setting ~s? [~a] " name default-value) + (force-output) + (let ((new-value (string-trim-right (read-line)))) + (unless (string=? new-value current-value) + (invoke "git" "config" "--global" name (if (string=? new-value "") default-value new-value))))))) + +(define (configure-git) + ; Or just ask user to do `guix shell -C` in the guix checkout directory + (format #t "This will set up your user's git. If you don't want us to do that, cancel now.~%") + + (if (string=? (invoke-and-read "git" "-h") "") + (exit 1)) +; Please install `git'--for example by entering the guix environment using `guix shell -C'" + + (if (string=? (invoke-and-read "git" "send-email" "-h") "") + (exit 1)) + ; (leave "Please install `git send-email'--for example by entering the guix environment using `guix shell -C'") + + (ensure-git-setting "user.email" "") + (ensure-git-setting "user.name" "") + + (ensure-git-setting "sendemail.smtpserver" "") + (ensure-git-setting "sendemail.smtpencryption" "tls") + (ensure-git-setting "sendemail.smtpserverport" "587") + (ensure-git-setting "sendemail.smtpuser" "") + (ensure-git-setting "sendemail.smtppass" "")) + +; duplicate +(define (authorized-directory-file) + "Return the name of the file listing directories for which 'guix shell' may +automatically load 'guix.scm' or 'manifest.scm' files." + (string-append (config-directory) "/shell-authorized-directories")) + +; duplicate +(define (authorized-shell-directory? directory) + "Return true if DIRECTORY is among the authorized directories for automatic +loading. The list of authorized directories is read from +'authorized-directory-file'; each line must be either: an absolute file name, +a hash-prefixed comment, or a blank line." + (catch 'system-error + (lambda () + (call-with-input-file (authorized-directory-file) + (lambda (port) + (let loop () + (match (read-line port) + ((? eof-object?) #f) + ((= string-trim line) + (cond ((string-prefix? "#" line) ;comment + (loop)) + ((string-prefix? "/" line) ;absolute file name + (or (string=? line directory) + (loop))) + ((string-null? (string-trim-right line)) ;blank line + (loop)) + (else ;bogus line + (let ((loc (location (port-filename port) + (port-line port) + (port-column port)))) + (warning loc (G_ "ignoring invalid file name: '~a'~%") + line)))))))))) + (const #f))) + +(define (prepare-guix-checkout destination-directory) + (mkdir-p destination-directory) + ; TODO: Somehow divine ssh URL ? + ; TODO: Resolve /gnu/store/w77psnbryxvpjxh54y1q7l7gby5dr5vk-guix-module-union/share/guile/site/3.0/gnu/packages/android.scm back to channel git url and commit; then check (at least) that out. + ; So: iterate over channels; find where the source file corresponding to the package is? + ; Then: Use starting-commit from the respective channel? Not sure what that's for in the first place + ; Then: Dynamically set destination-directory + ; TODO: ref '(branch . "master") + ; TODO: --depth 1 or something + (update-cached-checkout "https://git.savannah.gnu.org/git/guix.git" #:ref '() #:cache-directory destination-directory) + ; More guix-environment* options: + ; (package ad-hoc-package "nano") + ; (ad-hoc? . #t) + ; (system . "x86_64-linux") + ; (substitutes? . #t) + ; (symlinks) + ; (offload? . #t) + ; (graft? . #t) + ; (print-build-trace? . #t) + ; (print-extended-build-trace? . #t) + ; (multiplexed-build-output? . #t) + ; (debug . 0) + ; (verbosity . 1) + (define (in-guix-checkout command) + (guix-environment* `((package package "guix") (ad-hoc? . #f) (debug . 0) (verbosity . 1) (exec . ,command)))) ; TODO: opts instead of '() + + ;; Append destination-directory to (authorized-directory-file) + (unless (authorized-shell-directory? destination-directory) + (let ((output-port (open-file (authorized-directory-file) "a"))) + (newline output-port) + (display destination-directory output-port) + (newline output-port) + (close output-port))) + + ; TODO: ask whether to do a dev mode setup and hint that it will change user-global settings! + (format #t "Do you want to reconfigure the `git' version control system? (if you want to contribute your changes, this is useful) [y] ") + (force-output) + (let ((answer (string-trim-right (read-line)))) + (when (or (string=? answer "y") + (string=? answer "yes")) + (configure-git))) + + ; Build Guix + (in-guix-checkout '("sh" "-c" "./bootstrap && ./configure --localstatedir=/var --sysconfdir=/etc --disable-daemon && make -j")) + ; FIXME: we died because of the exec, but we still wanted to print a hint +) + + + +(define-command (guix-contrib . args) + (category development) + (synopsis "contribute to Guix") + + (with-error-handling + (define opts + (parse-args args)) + (let ((arguments (reverse (filter-map (match-lambda ((argument . b) b)) opts)))) + (match arguments + (("edit" packages ...) + (begin + (let ((destination-directory (string-append (getenv "HOME") "/src/guix"))) + (prepare-guix-checkout destination-directory) + (display-hint (G_ "In the future, if you want a much faster workflow, please directly edit files in ~s and also invoke `./pre-inst-env guix ~a' in there.") destination-directory (string-join args " ")) + (display-hint (G_ "If you are done and you want to email patches for review, you can use `git send-email -r origin/master --cover-letter --annotate' or similar.")) + #t + ))))))) diff --git a/guix/scripts/edit.scm b/guix/scripts/edit.scm index 5ce2870c5a..29e0fc4191 100644 --- a/guix/scripts/edit.scm +++ b/guix/scripts/edit.scm @@ -21,6 +21,7 @@ (define-module (guix scripts edit) #:use-module (guix ui) #:use-module (guix scripts) + #:use-module (guix store) #:use-module ((guix scripts build) #:select (%standard-build-options)) #:use-module ((guix diagnostics) #:select (location-file location-line)) @@ -71,28 +72,38 @@ (define (search-path* path file) file path)) absolute-file-name)) -(define (location->location-specification location) - "Return the location specification for LOCATION for a typical editor command -line." - (list (string-append "+" - (number->string - (location-line location))) - (search-path* %load-path (location-file location)))) - -(define (spawn-editor locations) +(define (spawn-editor locations specs) "Spawn (%editor) to edit the code at LOCATIONS, a list of records, and exit." - (catch 'system-error - (lambda () - (let ((file-names (append-map location->location-specification - locations))) - ;; Use `system' instead of `exec' in order to sanely handle - ;; possible command line arguments in %EDITOR. - (exit (system (string-join (cons (%editor) file-names)))))) - (lambda args - (let ((errno (system-error-errno args))) - (leave (G_ "failed to launch '~a': ~a~%") - (%editor) (strerror errno)))))) + + (let ((location->location-specification + (lambda (location) + "Return the location specification for LOCATION for a typical +editor command line. As a side-effect, if the LOCATION is a store path, +leave with an error message." + (list (string-append "+" + (number->string + (location-line location))) + + (let ((path (search-path* %load-path (location-file location)))) + (if (store-path? path) + (leave (G_ " '~a' is not directly editable.~% +Hint: Try 'guix contrib edit ~a' in order to prepare a Guix development environment +in your home directory and edit it there.~%") + path (string-join specs " ")) + path)))))) + + (catch 'system-error + (lambda () + (let ((file-names (append-map location->location-specification + locations))) + ;; Use `system' instead of `exec' in order to sanely handle + ;; possible command line arguments in %EDITOR. + (exit (system (string-join (cons (%editor) file-names)))))) + (lambda args + (let ((errno (system-error-errno args))) + (leave (G_ "failed to launch '~a': ~a~%") + (%editor) (strerror errno))))))) (define-command (guix-edit . args) @@ -111,4 +122,4 @@ (define-command (guix-edit . args) (when (null? specs) (leave (G_ "no packages specified, nothing to edit~%"))) - (spawn-editor locations)))) + (spawn-editor locations (parse-arguments))))) diff --git a/manifest.scm b/manifest.scm new file mode 100644 index 0000000000..00aaaae8e9 --- /dev/null +++ b/manifest.scm @@ -0,0 +1 @@ +(specifications->manifest '("git" "git:send-email")) base-commit: 37a8f92340f45baf096629866354bd088475456a -- 2.39.2