guix/build/hg.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
   3 ;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
   4 ;;; Copyright © 2018 Björn Höfling <bjoern.hoefling@bjoernhoefling.de>
   5 ;;;
   6 ;;; This file is part of GNU Guix.
   7 ;;;
   8 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   9 ;;; under the terms of the GNU General Public License as published by
  10 ;;; the Free Software Foundation; either version 3 of the License, or (at
  11 ;;; your option) any later version.
  12 ;;;
  13 ;;; GNU Guix is distributed in the hope that it will be useful, but
  14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;;; GNU General Public License for more details.
  17 ;;;
  18 ;;; You should have received a copy of the GNU General Public License
  19 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 (define-module (guix build hg)
  22   #:use-module (guix build utils)
  23   #:export (hg-fetch))
  24
  25 ;;; Commentary:
  26 ;;;
  27 ;;; This is the build-side support code of (guix hg-download).  It allows a
  28 ;;; Mercurial repository to be cloned and checked out at a specific changeset
  29 ;;; identifier.
  30 ;;;
  31 ;;; Code:
  32
  33 (define* (hg-fetch url changeset directory
  34                    #:key (hg-command "hg"))
  35   "Fetch CHANGESET from URL into DIRECTORY.  CHANGESET must be a valid
  36 Mercurial changeset identifier.  Return #t on success, #f otherwise."
  37
  38   (invoke hg-command
  39           "clone" url
  40           "--rev" changeset
  41           ;; Disable TLS certificate verification.  The hash of
  42           ;; the checkout is known in advance anyway.
  43           "--insecure"
  44           directory)
  45
  46   ;; The contents of '.hg' vary as a function of the current
  47   ;; status of the Mercurial repo.  Since we want a fixed
  48   ;; output, this directory needs to be taken out.
  49   ;; Since the '.hg' file is also in sub-modules, we have to
  50   ;; search for it in all sub-directories.
  51   (for-each delete-file-recursively
  52             (find-files directory "^\\.hg$" #:directories? #t))
  53
  54   #t)
  55
  56 ;;; hg.scm ends here