aboutsummaryrefslogtreecommitdiff
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019-2020, 2022, 2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz
;;;
;;; 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 <http://www.gnu.org/licenses/>.

(define-module (test-git)
  #:use-module (git)
  #:use-module (guix git)
  #:use-module (guix tests git)
  #:use-module ((guix utils) #:select (call-with-temporary-directory))
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-64)
  #:use-module (srfi srfi-71)
  #:use-module (ice-9 popen)
  #:use-module (ice-9 textual-ports))

;; Test the (guix git) tools.

(test-begin "git")

(test-assert "commit-difference, linear history"
  (with-temporary-git-repository directory
      '((add "a.txt" "A")
        (commit "first commit")
        (add "b.txt" "B")
        (commit "second commit")
        (add "c.txt" "C")
        (commit "third commit")
        (add "d.txt" "D")
        (commit "fourth commit"))
    (with-repository directory repository
      (let ((commit1 (find-commit repository "first"))
            (commit2 (find-commit repository "second"))
            (commit3 (find-commit repository "third"))
            (commit4 (find-commit repository "fourth")))
        (and (lset= eq? (commit-difference commit4 commit1)
                    (list commit2 commit3 commit4))
             (lset= eq? (commit-difference commit4 commit2)
                    (list commit3 commit4))
             (equal? (commit-difference commit3 commit2)
                     (list commit3))

             ;; COMMIT4 is not an ancestor of COMMIT1 so we should get the
             ;; empty list.
             (null? (commit-difference commit1 commit4)))))))

(test-assert "commit-difference, fork"
  (with-temporary-git-repository directory
      '((add "a.txt" "A")
        (commit "first commit")
        (branch "devel")
        (checkout "devel")
        (add "devel/1.txt" "1")
        (commit "first devel commit")
        (add "devel/2.txt" "2")
        (commit "second devel commit")
        (checkout "master")
        (add "b.txt" "B")
        (commit "second commit")
        (add "c.txt" "C")
        (commit "third commit")
        (merge "devel" "merge")
        (add "d.txt" "D")
        (commit "fourth commit"))
    (with-repository directory repository
      (let ((master1 (find-commit repository "first commit"))
            (master2 (find-commit repository "second commit"))
            (master3 (find-commit repository "third commit"))
            (master4 (find-commit repository "fourth commit"))
            (devel1  (find-commit repository "first devel"))
            (devel2  (find-commit repository "second devel"))
            (merge   (find-commit repository "merge")))
        (and (equal? (commit-difference master4 merge)
                     (list master4))
             (lset= eq? (commit-difference master3 master1)
                    (list master3 master2))
             (lset= eq? (commit-difference devel2 master1)
                    (list devel2 devel1))

             ;; The merge occurred between MASTER2 and MASTER4 so here we
             ;; expect to see all the commits from the "devel" branch in
             ;; addition to those on "master".
             (lset= eq? (commit-difference master4 master2)
                    (list master4 merge master3 devel1 devel2)))))))

(test-assert "commit-difference, excluded commits"
  (with-temporary-git-repository directory
      '((add "a.txt" "A")
        (commit "first commit")
        (add "b.txt" "B")
        (commit "second commit")
        (add "c.txt" "C")
        (commit "third commit")
        (add "d.txt" "D")
        (commit "fourth commit")
        (add "e.txt" "E")
        (commit "fifth commit"))
    (with-repository directory repository
      (let ((commit1 (find-commit repository "first"))
            (commit2 (find-commit repository "second"))
            (commit3 (find-commit repository "third"))
            (commit4 (find-commit repository "fourth"))
            (commit5 (find-commit repository "fifth")))
        (and (lset= eq? (commit-difference commit4 commit1 (list commit2))
                    (list commit3 commit4))
             (lset= eq? (commit-difference commit4 commit1 (list commit3))
                    (list commit4))
             (null? (commit-difference commit4 commit1 (list commit5))))))))

(test-equal "commit-relation"
  '(self                                          ;master3 master3
    ancestor                                      ;master1 master3
    descendant                                    ;master3 master1
    unrelated                                     ;master2 branch1
    unrelated                                     ;branch1 master2
    ancestor                                      ;branch1 merge
    descendant                                    ;merge branch1
    ancestor                                      ;master1 merge
    descendant)                                   ;merge master1
  (with-temporary-git-repository directory
      '((add "a.txt" "A")
        (commit "first commit")
        (branch "hack")
        (checkout "hack")
        (add "1.txt" "1")
        (commit "branch commit")
        (checkout "master")
        (add "b.txt" "B")
        (commit "second commit")
        (add "c.txt" "C")
        (commit "third commit")
        (merge "hack" "merge"))
    (with-repository directory repository
      (let ((master1 (find-commit repository "first"))
            (master2 (find-commit repository "second"))
            (master3 (find-commit repository "third"))
            (branch1 (find-commit repository "branch"))
            (merge   (find-commit repository "merge")))
        (list (commit-relation master3 master3)
              (commit-relation master1 master3)
              (commit-relation master3 master1)
              (commit-relation master2 branch1)
              (commit-relation branch1 master2)
              (commit-relation branch1 merge)
              (commit-relation merge branch1)
              (commit-relation master1 merge)
              (commit-relation merge master1))))))

(test-equal "commit-descendant?"
  '((master3 master3 => #t)
    (master1 master3 => #f)
    (master3 master1 => #t)
    (master2 branch1 => #f)
    (master2 branch1 master1 => #t)
    (branch1 master2 => #f)
    (branch1 merge   => #f)
    (merge branch1   => #t)
    (master1 merge   => #f)
    (merge master1   => #t))
  (with-temporary-git-repository directory
      '((add "a.txt" "A")
        (commit "first commit")
        (branch "hack")
        (checkout "hack")
        (add "1.txt" "1")
        (commit "branch commit")
        (checkout "master")
        (add "b.txt" "B")
        (commit "second commit")
        (add "c.txt" "C")
        (commit "third commit")
        (merge "hack" "merge"))
    (with-repository directory repository
      (let ((master1 (find-commit repository "first"))
            (master2 (find-commit repository "second"))
            (master3 (find-commit repository "third"))
            (branch1 (find-commit repository "branch"))
            (merge   (find-commit repository "merge")))
        (letrec-syntax ((verify
                         (syntax-rules ()
                           ((_) '())
                           ((_ (new old ...) rest ...)
                            (cons `(new old ... =>
                                        ,(commit-descendant? new
                                                             (list old ...)))
                                  (verify rest ...))))))
          (verify (master3 master3)
                  (master1 master3)
                  (master3 master1)
                  (master2 branch1)
                  (master2 branch1 master1)
                  (branch1 master2)
                  (branch1 merge)
                  (merge branch1)
                  (master1 merge)
                  (merge master1)))))))

(test-equal "remote-refs"
  '("refs/heads/develop" "refs/heads/master"
    "refs/tags/v1.0" "refs/tags/v1.1")
  (with-temporary-git-repository directory
      '((add "a.txt" "A")
        (commit "First commit")
        (tag "v1.0" "release-1.0")
        (branch "develop")
        (checkout "develop")
        (add "b.txt" "B")
        (commit "Second commit")
        (tag "v1.1" "release-1.1"))
    (remote-refs directory)))

(test-equal "remote-refs: only tags"
 '("refs/tags/v1.0" "refs/tags/v1.1")
  (with-temporary-git-repository directory
      '((add "a.txt" "A")
        (commit "First commit")
        (tag "v1.0" "Release 1.0")
        (add "b.txt" "B")
        (commit "Second commit")
        (tag "v1.1" "Release 1.1"))
    (remote-refs directory #:tags? #t)))

(test-assert "update-cached-checkout, tag"
  (call-with-temporary-directory
   (lambda (cache)
     (with-temporary-git-repository directory
         '((add "a.txt" "A")
           (commit "First commit")
           (tag "v1.0" "release-1.0")
           (branch "develop")
           (checkout "develop")
           (add "b.txt" "B")
           (commit "Second commit")
           (tag "v1.1" "release-1.1"))
       (let ((directory commit relation
                        (update-cached-checkout directory
                                                #:ref '(tag . "v1.1")
                                                #:cache-directory cache))
             (head   (let* ((pipe (open-pipe* OPEN_READ (git-command)
                                              "-C" directory
                                              "rev-parse" "HEAD"))
                            (str  (get-string-all pipe)))
                       (close-pipe pipe)
                       (string-trim-right str))))
         ;; COMMIT should be the ID of the commit object, not that of the tag.
         (string=? commit head))))))

(test-assert "update-cached-checkout, untracked files removed"
  (call-with-temporary-directory
   (lambda (cache)
     (with-temporary-git-repository directory
         '((add "a.txt" "A")
           (add ".gitignore" ".~\n")
           (commit "First commit"))
       (let ((directory commit relation
                        (update-cached-checkout directory
                                                #:ref '()
                                                #:cache-directory cache)))
         (close-port
          (open-output-file (in-vicinity cache "stale-untracked-file")))
         (let ((directory2 commit2 relation2
                           (update-cached-checkout directory
                                                   #:ref '()
                                                   #:cache-directory cache)))
           (not (file-exists?
                 (in-vicinity cache "stale-untracked-file")))))))))

(test-end "git")
h: Warn about 'password-authentication?' default."...This reverts commit aecd2a13cbd8301d0fdeafcacbf69e12cc3f6138 for two reasons: 1. The warning would fire every time (gnu services ssh) is loaded; 2. There's still no clear consensus on the approach to follow as discussed in <https://issues.guix.gnu.org/44808>. Ludovic Courtès 2020-12-07services: openssh: Warn about 'password-authentication?' default....Fixes <https://bugs.gnu.org/44808>. Reported by Christopher Lemmer Webber <cwebber@dustycloud.org>. * gnu/services/ssh.scm (true-but-soon-false): New procedure. (<openssh-configuration>)[password-authentication?]: Change default to 'true-but-soon-false'. * gnu/installer/services.scm (%system-services): Explicitly set 'password-authentication?' to #f. Ludovic Courtès 2020-11-17installer: Fix device synchronization....Reported by Florian Pelz: https://lists.gnu.org/archive/html/guix-devel/2020-11/msg00326.html. * gnu/installer/utils.scm (call-with-time): New procedure, (let/time): new macro. * gnu/installer/parted.scm (with-delay-device-in-use?): Increase the retry count to 16. (non-install-devices): Remove the call to with-delay-device-in-use? as it doesn't return the expected result, and would block much longer now. (free-parted): Log the time required to sync each device. Mathieu Othacehe 2020-11-08installer: parted: Add debug output....* gnu/installer/parted.scm (mkpart): Log partition creation. Mathieu Othacehe 2020-11-07installer: parameters: Add a reboot button....Suggested by: zimoun <zimon.toutoune@gmail.com>. * gnu/installer/newt/parameters.scm (run-parameters-page): Add a reboot button. Mathieu Othacehe 2020-11-07installer: Edit partitioning warning message....* gnu/installer/newt/partition.scm (draw-formatting-page): Add an extra new line. Mathieu Othacehe 2020-11-07installer: Limit listbox height....Fixes: <https://issues.guix.gnu.org/44428>. * gnu/installer/newt.scm (init): Print screen size. * gnu/installer/newt/page.scm (default-listbox-height): New variable. (run-listbox-selection-page): Use it. * gnu/installer/newt/wifi.scm (wifi-listbox-height): Ditto. * gnu/installer/newt/network.scm (run-technology-page): Set the maximum listbox height to 5. * gnu/installer/newt/ethernet.scm (run-ethernet-page): Ditto. * gnu/installer/newt/final.scm (run-config-display-page): Change listbox height. * gnu/installer/newt/partition.scm (run-disk-page): Ditto. * gnu/installer/newt/welcome.scm (display-logo?): New procedure. (run-menu-page): Use it. * gnu/installer/steps.scm (%configuration-file-width): Remove it. Mathieu Othacehe 2020-11-02installer: Report to the user the formatted partitions....* gnu/installer/newt/partitions.scm (define-module): Use (ice-9 format). (draw-formatting-page): Add parameter partitions and provide the list of formatted partitions to the user. (run-partitioning-page): Provide user-partitions to draw-formatting-page. Miguel Ángel Arruga Vivas 2020-11-01installer: parted: Internationalize the partition handling code....* gnu/installer/parted.scm (user-partition-description): Use 'format' and 'G_' for i18n. Ludovic Courtès 2020-10-30installer: Use UUIDs in the 'swap-devices' field....Note: This change requires an updated 'guix' package that contains Linux-swap support in (gnu build file-systems). * gnu/installer/parted.scm (user-partitions->configuration): Use UUIDs in the 'swap-devices' field. * gnu/installer/newt/final.scm (run-final-page)[wait-for-clients]: New procedure. Use it. * gnu/installer/tests.scm (choose-partitioning): Wait for 'starting-final-step' message and move configuration file dialog handling to... (conclude-installation): ... here. Send over PORT the reply corresponding to 'starting-final-step'. * gnu/tests/install.scm (gui-test-program): When ENCRYPTED? is false, invoke 'swaplabel' in the marionette. (installation-target-os-for-gui-tests): When ENCRYPTED? is false, except a fixed UUID. Ludovic Courtès 2020-10-28installer: Log partition formatting....* gnu/installer/newt/partition.scm (run-partitioning-page): Add 'syslog' call. Ludovic Courtès 2020-10-23installer: Make the network management selection window tighter....* gnu/installer/newt/services.scm (run-network-management-page): Pass #:listbox-height. Ludovic Courtès 2020-10-19installer: Create bios_grub partition when it is needed....* gnu/installer/parted.scm (auto-partition!): Only check for ESP on EFI installations. Miguel Ángel Arruga Vivas 2020-10-13installer: Add Emacs EXWM desktop environment....Suggested by zenny via IRC. * gnu/installer/services.scm (%system-services): Add emacs, emacs-exwm, emacs-desktop-environment. * etc/release-manifest.scm (%system-packages): Likewise. * gnu/system/examples/lightweight-desktop.tmpl: Likewise. * gnu/tests/install.scm (installation-target-desktop-os-for-gui-tests) [packages]: Likewise * gnu/installer/newt/services.scm (run-desktop-environments-cbt-page): Make one entry taller. Jan (janneke) Nieuwenhuizen 2020-09-21installer: Rename RUN-PARTIONING-PAGE....* gnu/installer/newt/partition.scm (run-partioning-page): Rename to run-partitioning-page. Adjust all callers. Tobias Geerinckx-Rice 2020-09-21installer: Fix docstring typoes....* gnu/installer/connman.scm (connman-state, run-locale-page) (start-swapping, stop-swapping, run-installer-steps): Fix typo in docstring. Tobias Geerinckx-Rice 2020-09-10installer: final: Introduce call-with-mnt-container....* gnu/installer/final.scm (call-with-mnt-container): New procedure, (install-system): use it instead of call-with-container, to make sure that the container is not jailed. Mathieu Othacehe 2020-09-02installer: Run the installation inside a container....When the store overlay is mounted, other processes such as kmscon, udev and guix-daemon may open files from the store, preventing the underlying install support from being umounted. See: https://lists.gnu.org/archive/html/guix-devel/2018-12/msg00161.html. To avoid this situation, mount the store overlay inside a container, and run the installation from within that container. * gnu/build/shepherd.scm (fork+exec-command/container): New procedure. * gnu/services/base.scm (guix-shepherd-service): Support an optional PID argument passed to the "start" method. If that argument is passed, ensure that guix-daemon enters the given PID MNT namespace by using fork+exec-command/container procedure. * gnu/installer/final.scm (umount-cow-store): Remove it, (install-system): run the installation from within a container. * gnu/installer/newt/final.scm (run-install-shell): Remove the display hack. Mathieu Othacehe 2020-08-06installer: Remove logical devices....If a device contains an active logical volume, BLKRRPART will report that the device is busy. This will cause this device to be filtered by "non-install-devices" procedure, which is not desired. Make sure to deactivate all logical volumes before device probing. Fixes <https://issues.guix.gnu.org/42683>. * gnu/installer.scm (installer-program): Add lvm2-static to the inputs. * gnu/installer/parted.scm (remove-logical-devices): New procedure, (init-parted): call it. Mathieu Othacehe 2020-07-26installer: Add NTFS support....This adds support for creating and editing NTFS partitions. It is however not possible yet to create root NTFS partitions, as overlaying on top of a fuse partition does not seem supported. * gnu/installer.scm (installer-program): Add "ntfs-3g" to the inputs. * gnu/installer/parted.scm (user-fs-type-name, user-fs-type->mount-type, partition-filesystem-user-type, create-ntfs-file-system, format-user-partitions): Add NTFS support. * gnu/installer/newt/partition.scm (run-fs-type-page): Add NTFS support. Mathieu Othacehe