aboutsummaryrefslogtreecommitdiff
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;;
;;; 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-hackage)
  #:use-module (guix import cabal)
  #:use-module (guix import hackage)
  #:use-module (guix tests)
  #:use-module (srfi srfi-64)
  #:use-module (ice-9 match))

(define test-cabal-1
  "name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
executable cabal
  build-depends:
    HTTP       >= 4000.2.5 && < 4000.3,
    mtl        >= 2.0      && < 3
")

(define test-cabal-2
  "name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
executable cabal {
build-depends:
  HTTP       >= 4000.2.5 && < 4000.3,
  mtl        >= 2.0      && < 3
}
")

;; Check compiler implementation test with and without spaces.
(define test-cabal-3
  "name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
library
  if impl(ghc >= 7.2 && < 7.6)
    Build-depends: ghc-a
  if impl(ghc>=7.2&&<7.6)
    Build-depends: ghc-b
  if impl(ghc == 7.8)
    Build-depends: 
      HTTP       >= 4000.2.5 && < 4000.3,
      mtl        >= 2.0      && < 3
")

;; Check "-any", "-none" when name is different.
(define test-cabal-4
  "name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
library
  if impl(ghcjs -any)
    Build-depends: ghc-a
  if impl(ghc>=7.2&&<7.6)
    Build-depends: ghc-b
  if impl(ghc == 7.8)
    Build-depends: 
      HTTP       >= 4000.2.5 && < 4000.3,
      mtl        >= 2.0      && < 3
")

;; Check "-any", "-none".
(define test-cabal-5
  "name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
library
  if impl(ghc == 7.8)
    Build-depends: 
      HTTP       >= 4000.2.5 && < 4000.3,
  if impl(ghc -any)
    Build-depends: mtl        >= 2.0      && < 3
  if impl(ghc>=7.2&&<7.6)
    Build-depends: ghc-b
")

;; Check "custom-setup".
(define test-cabal-6
  "name: foo
build-type: Custom
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
custom-setup
  setup-depends: base >= 4.7 && < 5,
                 Cabal >= 1.24,
                 haskell-gi == 0.21.*
library
  if impl(ghc>=7.2&&<7.6)
    Build-depends: ghc-b
  if impl(ghc == 7.8)
    Build-depends: 
      HTTP       >= 4000.2.5 && < 4000.3,
      mtl        >= 2.0      && < 3
")

;; A fragment of a real Cabal file with minor modification to check precedence
;; of 'and' over 'or', missing final newline, spaces between keywords and
;; parentheses and between key and column.
(define test-read-cabal-1
  "name: test-me
library
  -- Choose which library versions to use.
  if flag(base4point8)
    Build-depends: base >= 4.8 && < 5
  else
    if flag(base4)
      Build-depends: base >= 4 && < 4.8
    else
      if flag(base3)
        Build-depends: base >= 3 && < 4
      else
        Build-depends: base < 3
  if flag(base4point8) || flag (base4) && flag(base3)
    Build-depends: random
  Build-depends : containers

  -- Modules that are always built.
  Exposed-Modules:
    Test.QuickCheck.Exception")

(define test-read-cabal-2
  "name: test-me
common defaults
    if os(foobar) { cc-options: -DBARBAZ }
") ; Intentional newline.

;; Test opening bracket on new line.
(define test-read-cabal-brackets-newline
  "name: test-me
common defaults
    build-depends:
    {  foobar
    ,  barbaz
    }
")

;; Test library with (since Cabal 2.0) and without names.
(define test-read-cabal-library-name
  "name: test-me
library foobar
    build-depends: foo, bar
library
    build-depends: bar, baz
")

(test-begin "hackage")

(define-syntax-rule (define-package-matcher name pattern)
  (define* (name obj)
    (match obj
      (pattern #t)
      (x       (pk 'fail x #f)))))

(define-package-matcher match-ghc-foo
  ('package
    ('name "ghc-foo")
    ('version "1.0.0")
    ('source
     ('origin
       ('method 'url-fetch)
       ('uri ('hackage-uri "foo" 'version))
       ('sha256
        ('base32
         (? string? hash)))))
    ('build-system 'haskell-build-system)
    ('properties '(quote ((upstream-name . "foo"))))
    ('inputs ('list 'ghc-http))
    ('home-page "http://test.org")
    ('synopsis (? string?))
    ('description (? string?))
    ('license 'license:bsd-3)))

(define* (eval-test-with-cabal test-cabal matcher #:key (cabal-environment '()))
  (define port (open-input-string test-cabal))
  (matcher (hackage->guix-package "foo" #:port port #:cabal-environment cabal-environment)))

(test-assert "hackage->guix-package test 1"
  (eval-test-with-cabal test-cabal-1 match-ghc-foo))

(test-assert "hackage->guix-package test 2"
  (eval-test-with-cabal test-cabal-2 match-ghc-foo))

(test-assert "hackage->guix-package test 3"
  (eval-test-with-cabal test-cabal-3 match-ghc-foo
                        #:cabal-environment '(("impl" . "ghc-7.8"))))

(test-assert "hackage->guix-package test 4"
  (eval-test-with-cabal test-cabal-4 match-ghc-foo
                        #:cabal-environment '(("impl" . "ghc-7.8"))))

(test-assert "hackage->guix-package test 5"
  (eval-test-with-cabal test-cabal-5 match-ghc-foo
                        #:cabal-environment '(("impl" . "ghc-7.8"))))

(define-package-matcher match-ghc-foo-6
  ('package
    ('name "ghc-foo")
    ('version "1.0.0")
    ('source
     ('origin
       ('method 'url-fetch)
       ('uri ('hackage-uri "foo" 'version))
       ('sha256
        ('base32
         (? string? hash)))))
    ('build-system 'haskell-build-system)
    ('properties '(quote ((upstream-name . "foo"))))
    ('inputs ('list 'ghc-b 'ghc-http))
    ('native-inputs ('list 'ghc-haskell-gi))
    ('home-page "http://test.org")
    ('synopsis (? string?))
    ('description (? string?))
    ('license 'license:bsd-3)))

(test-assert "hackage->guix-package test 6"
  (eval-test-with-cabal test-cabal-6 match-ghc-foo-6))

;; Check multi-line layouted description.
(define test-cabal-multiline-layout
  "name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description:   first line
               second line
license: BSD3
executable cabal
  build-depends:
    HTTP       >= 4000.2.5 && < 4000.3,
    mtl        >= 2.0      && < 3
")

(test-assert "hackage->guix-package test multiline desc (layout)"
  (eval-test-with-cabal test-cabal-multiline-layout match-ghc-foo))

;; Check multi-line braced description.
(define test-cabal-multiline-braced
  "name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: {
first line
second line
}
license: BSD3
executable cabal
  build-depends:
    HTTP       >= 4000.2.5 && < 4000.3,
    mtl        >= 2.0      && < 3
")

(test-assert "hackage->guix-package test multiline desc (braced)"
  (eval-test-with-cabal test-cabal-multiline-braced match-ghc-foo))

;; Check mixed layout. Compare e.g. warp.
(define test-cabal-mixed-layout
  "name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
executable cabal
    build-depends:
      HTTP       >= 4000.2.5 && < 4000.3,
      mtl        >= 2.0      && < 3
  ghc-options: -Wall
")

(test-assert "hackage->guix-package test mixed layout"
  (eval-test-with-cabal test-cabal-mixed-layout match-ghc-foo))

;; Check flag executable. Compare e.g. darcs.
(define test-cabal-flag-executable
  "name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
flag executable
  description: Build executable
  default:     True
executable cabal
  if !flag(executable)
    buildable: False
  else
    buildable: True

  build-depends:
    HTTP       >= 4000.2.5 && < 4000.3,
    mtl        >= 2.0      && < 3
")

(test-assert "hackage->guix-package test flag executable"
  (eval-test-with-cabal test-cabal-flag-executable match-ghc-foo))

;; There is no mandatory space between property name and value.
(define test-cabal-property-no-space
  "name:foo
version:1.0.0
homepage:http://test.org
synopsis:synopsis
description:description
license:BSD3
common bench-defaults
  ghc-options:-Wall
executable cabal
  build-depends:
    HTTP       >= 4000.2.5 && < 4000.3,
    mtl        >= 2.0      && < 3
")

(test-assert "hackage->guix-package test properties without space"
  (eval-test-with-cabal test-cabal-property-no-space match-ghc-foo))

;; There may be no final newline terminating a property.
(define test-cabal-no-final-newline
"name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
executable cabal
  build-depends: HTTP       >= 4000.2.5 && < 4000.3, mtl        >= 2.0      && < 3")

(test-expect-fail 1)
(test-assert "hackage->guix-package test without final newline"
  (eval-test-with-cabal test-cabal-no-final-newline match-ghc-foo))

;; Make sure internal libraries will not be part of the dependencies,
;; ignore case.
(define test-cabal-internal-library-ignored
  "name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
executable cabal
  build-depends:
    HTTP       >= 4000.2.5 && < 4000.3,
    internAl
library internaL
  build-depends: mtl        >= 2.0      && < 3
")

(test-assert "hackage->guix-package test internal libraries are ignored"
  (eval-test-with-cabal test-cabal-internal-library-ignored match-ghc-foo))

;; Check if-elif-else statements
(define test-cabal-if
  "name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
library
  if os(first)
    Build-depends: ghc-c
")

(define test-cabal-else
  "name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
library
  if os(first)
    Build-depends: ghc-a
  else
    Build-depends: ghc-c
")

(define test-cabal-elif
  "name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
library
  if os(first)
    Build-depends: ghc-a
  elif os(second)
    Build-depends: ghc-b
  elif os(guix)
    Build-depends: ghc-c
  elif os(third)
    Build-depends: ghc-d
  else
    Build-depends: ghc-e
")

;; Try the same with different bracket styles
(define test-cabal-elif-brackets
  "name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
library
  if os(first) {
    Build-depends: ghc-a
  }
  elif os(second)
    Build-depends: ghc-b
  elif os(guix) { Build-depends: ghc-c }
  elif os(third) {
    Build-depends: ghc-d }
  elif os(fourth)
  {
    Build-depends: ghc-d
  } else
    Build-depends: ghc-e
")

(define-package-matcher match-ghc-elif
  ('package
    ('name "ghc-foo")
    ('version "1.0.0")
    ('source
     ('origin
       ('method 'url-fetch)
       ('uri ('hackage-uri "foo" 'version))
       ('sha256
        ('base32
         (? string? hash)))))
    ('build-system 'haskell-build-system)
    ('properties '(quote ((upstream-name . "foo"))))
    ('inputs ('list 'ghc-c))
    ('home-page "http://test.org")
    ('synopsis (? string?))
    ('description (? string?))
    ('license 'license:bsd-3)))

(test-assert "hackage->guix-package test lonely if statement"
  (eval-test-with-cabal test-cabal-else match-ghc-elif
                        #:cabal-environment '(("os" . "guix"))))

(test-assert "hackage->guix-package test else statement"
  (eval-test-with-cabal test-cabal-else match-ghc-elif
                        #:cabal-environment '(("os" . "guix"))))

(test-assert "hackage->guix-package test elif statement"
  (eval-test-with-cabal test-cabal-elif match-ghc-elif
                        #:cabal-environment '(("os" . "guix"))))

(test-assert "hackage->guix-package test elif statement with brackets"
  (eval-test-with-cabal test-cabal-elif-brackets match-ghc-elif
                        #:cabal-environment '(("os" . "guix"))))

;; Check Hackage Cabal revisions.
(define test-cabal-revision
  "name: foo
version: 1.0.0
x-revision: 2
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
executable cabal
  build-depends:
    HTTP       >= 4000.2.5 && < 4000.3,
    mtl        >= 2.0      && < 3
")

(define-package-matcher match-ghc-foo-revision
  ('package
    ('name "ghc-foo")
    ('version "1.0.0")
    ('source
     ('origin
       ('method 'url-fetch)
       ('uri ('hackage-uri "foo" 'version))
       ('sha256
        ('base32
         (? string? hash)))))
    ('build-system 'haskell-build-system)
    ('properties '(quote ((upstream-name . "foo"))))
    ('inputs ('list 'ghc-http))
    ('arguments
     ('quasiquote
      ('#:cabal-revision
       ("2" "0xxd88fb659f0krljidbvvmkh9ppjnx83j0nqzx8whcg4n5qbyng"))))
    ('home-page "http://test.org")
    ('synopsis (? string?))
    ('description (? string?))
    ('license 'license:bsd-3)))

(test-assert "hackage->guix-package test cabal revision"
  (eval-test-with-cabal test-cabal-revision match-ghc-foo-revision))

(test-assert "read-cabal test 1"
  (match (call-with-input-string test-read-cabal-1 read-cabal)
    ((("name" ("test-me"))
      ('section 'library #f
                (('if ('flag "base4point8")
                      (("build-depends" ("base >= 4.8 && < 5")))
                      (('if ('flag "base4")
                            (("build-depends" ("base >= 4 && < 4.8")))
                            (('if ('flag "base3")
                                  (("build-depends" ("base >= 3 && < 4")))
                                  (("build-depends" ("base < 3"))))))))
                 ('if ('or ('flag "base4point8")
                           ('and ('flag "base4") ('flag "base3")))
                      (("build-depends" ("random")))
                      ())
                 ("build-depends" ("containers"))
                 ("exposed-modules" ("Test.QuickCheck.Exception")))))
     #t)
    (x (pk 'fail x #f))))

(test-assert "read-cabal test: if brackets on the same line"
  (match (call-with-input-string test-read-cabal-2 read-cabal)
    ((("name" ("test-me"))
        ('section 'common "defaults"
          (('if ('os "foobar")
               (("cc-options" ("-DBARBAZ ")))
               ()))))
     #t)
    (x (pk 'fail x #f))))

(test-expect-fail 1)
(test-assert "read-cabal test: property brackets on new line"
  (match (call-with-input-string test-read-cabal-brackets-newline read-cabal)
    ((("name" ("test-me"))
        ('section 'common "defaults"
          (("build-depends" ("foobar ,  barbaz")))))
     #t)
    (x (pk 'fail x #f))))

(test-assert "read-cabal test: library name"
  (match (call-with-input-string test-read-cabal-library-name read-cabal)
    ((("name" ("test-me"))
        ('section 'library "foobar"
          (("build-depends" ("foo, bar"))))
        ('section 'library #f
          (("build-depends" ("bar, baz")))))
     #t)
    (x (pk 'fail x #f))))

(define test-cabal-import
  "name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
common commons
  build-depends:
    HTTP       >= 4000.2.5 && < 4000.3,
    mtl        >= 2.0      && < 3

executable cabal
  import: commons
")

(define-package-matcher match-ghc-foo-import
  ('package
    ('name "ghc-foo")
    ('version "1.0.0")
    ('source
     ('origin
       ('method 'url-fetch)
       ('uri ('hackage-uri "foo" 'version))
       ('sha256
        ('base32
         (? string? hash)))))
    ('build-system 'haskell-build-system)
    ('properties '(quote ((upstream-name . "foo"))))
    ('inputs ('list 'ghc-http))
    ('home-page "http://test.org")
    ('synopsis (? string?))
    ('description (? string?))
    ('license 'license:bsd-3)))

(test-assert "hackage->guix-package test cabal import"
  (eval-test-with-cabal test-cabal-import match-ghc-foo-import))

(define test-cabal-multiple-imports
  "name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
common commons
  build-depends:
    HTTP       >= 4000.2.5 && < 4000.3,
    mtl        >= 2.0      && < 3

common others
  build-depends:
    base == 4.16.*,
    stm-chans == 3.0.*

executable cabal
  import:
      commons
    , others
")

(define-package-matcher match-ghc-foo-multiple-imports
  ('package
    ('name "ghc-foo")
    ('version "1.0.0")
    ('source
     ('origin
       ('method 'url-fetch)
       ('uri ('hackage-uri "foo" 'version))
       ('sha256
        ('base32
         (? string? hash)))))
    ('build-system 'haskell-build-system)
    ('properties '(quote ((upstream-name . "foo"))))
    ('inputs ('list 'ghc-http 'ghc-stm-chans))
    ('home-page "http://test.org")
    ('synopsis (? string?))
    ('description (? string?))
    ('license 'license:bsd-3)))

(test-assert "hackage->guix-package test cabal multiple imports"
  (eval-test-with-cabal test-cabal-multiple-imports match-ghc-foo-multiple-imports))

(test-end "hackage")
generated by cgit
s an edge case, allow copying of closed AutoCloseFDs. This is necessary due to tiresome reasons involving copy constructor use on default object values in STL containers (like when you do `map[value]' where value isn't in the map yet). */ this->fd = fd.fd; if (this->fd != -1) abort(); } AutoCloseFD::~AutoCloseFD() { try { close(); } catch (...) { ignoreException(); } } void AutoCloseFD::operator =(int fd) { if (this->fd != fd) close(); this->fd = fd; } AutoCloseFD::operator int() const { return fd; } void AutoCloseFD::close() { if (fd != -1) { if (::close(fd) == -1) /* This should never happen. */ throw SysError(format("closing file descriptor %1%") % fd); fd = -1; } } bool AutoCloseFD::isOpen() { return fd != -1; } /* Pass responsibility for closing this fd to the caller. */ int AutoCloseFD::borrow() { int oldFD = fd; fd = -1; return oldFD; } void Pipe::create() { int fds[2]; if (pipe(fds) != 0) throw SysError("creating pipe"); readSide = fds[0]; writeSide = fds[1]; closeOnExec(readSide); closeOnExec(writeSide); } ////////////////////////////////////////////////////////////////////// AutoCloseDir::AutoCloseDir() { dir = 0; } AutoCloseDir::AutoCloseDir(DIR * dir) { this->dir = dir; } AutoCloseDir::~AutoCloseDir() { close(); } void AutoCloseDir::operator =(DIR * dir) { this->dir = dir; } AutoCloseDir::operator DIR *() { return dir; } void AutoCloseDir::close() { if (dir) { closedir(dir); dir = 0; } } ////////////////////////////////////////////////////////////////////// Pid::Pid() : pid(-1), separatePG(false), killSignal(SIGKILL) { } Pid::Pid(pid_t pid) : pid(pid), separatePG(false), killSignal(SIGKILL) { } Pid::~Pid() { kill(); } void Pid::operator =(pid_t pid) { if (this->pid != pid) kill(); this->pid = pid; killSignal = SIGKILL; // reset signal to default } Pid::operator pid_t() { return pid; } void Pid::kill(bool quiet) { if (pid == -1 || pid == 0) return; if (!quiet) printMsg(lvlError, format("killing process %1%") % pid); /* Send the requested signal to the child. If it has its own process group, send the signal to every process in the child process group (which hopefully includes *all* its children). */ if (::kill(separatePG ? -pid : pid, killSignal) != 0) printMsg(lvlError, (SysError(format("killing process %1%") % pid).msg())); /* Wait until the child dies, disregarding the exit status. */ int status; while (waitpid(pid, &status, 0) == -1) { checkInterrupt(); if (errno != EINTR) { printMsg(lvlError, (SysError(format("waiting for process %1%") % pid).msg())); break; } } pid = -1; } int Pid::wait(bool block) { assert(pid != -1); while (1) { int status; int res = waitpid(pid, &status, block ? 0 : WNOHANG); if (res == pid) { pid = -1; return status; } if (res == 0 && !block) return -1; if (errno != EINTR) throw SysError("cannot get child exit status"); checkInterrupt(); } } void Pid::setSeparatePG(bool separatePG) { this->separatePG = separatePG; } void Pid::setKillSignal(int signal) { this->killSignal = signal; } void killUser(uid_t uid) { debug(format("killing all processes running under uid `%1%'") % uid); assert(uid != 0); /* just to be safe... */ /* The system call kill(-1, sig) sends the signal `sig' to all users to which the current process can send signals. So we fork a process, switch to uid, and send a mass kill. */ Pid pid = startProcess([&]() { if (setuid(uid) == -1) throw SysError("setting uid"); while (true) { #ifdef __APPLE__ /* OSX's kill syscall takes a third parameter that, among other things, determines if kill(-1, signo) affects the calling process. In the OSX libc, it's set to true, which means "follow POSIX", which we don't want here */ if (syscall(SYS_kill, -1, SIGKILL, false) == 0) break; #elif __GNU__ /* Killing all a user's processes using PID=-1 does currently not work on the Hurd. */ if (kill(getpid(), SIGKILL) == 0) break; #else if (kill(-1, SIGKILL) == 0) break; #endif if (errno == ESRCH) break; /* no more processes */ if (errno != EINTR) throw SysError(format("cannot kill processes for uid `%1%'") % uid); } _exit(0); }); int status = pid.wait(true); #if __GNU__ /* When the child killed itself, status = SIGKILL. */ if (status == SIGKILL) return; #endif if (status != 0) throw Error(format("cannot kill processes for uid `%1%': %2%") % uid % statusToString(status)); /* !!! We should really do some check to make sure that there are no processes left running under `uid', but there is no portable way to do so (I think). The most reliable way may be `ps -eo uid | grep -q $uid'. */ } ////////////////////////////////////////////////////////////////////// pid_t startProcess(std::function<void()> fun, bool dieWithParent, const string & errorPrefix, bool runExitHandlers) { pid_t pid = fork(); if (pid == -1) throw SysError("unable to fork"); if (pid == 0) { _writeToStderr = 0; try { #if __linux__ if (dieWithParent && prctl(PR_SET_PDEATHSIG, SIGKILL) == -1) throw SysError("setting death signal"); #endif restoreAffinity(); fun(); } catch (std::exception & e) { try { std::cerr << errorPrefix << e.what() << "\n"; } catch (...) { } } catch (...) { } if (runExitHandlers) exit(1); else _exit(1); } return pid; } std::vector<char *> stringsToCharPtrs(const Strings & ss) { std::vector<char *> res; for (auto & s : ss) res.push_back((char *) s.c_str()); res.push_back(0); return res; } string runProgram(Path program, bool searchPath, const Strings & args) { checkInterrupt(); /* Create a pipe. */ Pipe pipe; pipe.create(); /* Fork. */ Pid pid = startProcess([&]() { if (dup2(pipe.writeSide, STDOUT_FILENO) == -1) throw SysError("dupping stdout"); Strings args_(args); args_.push_front(program); if (searchPath) execvp(program.c_str(), stringsToCharPtrs(args_).data()); else execv(program.c_str(), stringsToCharPtrs(args_).data()); throw SysError(format("executing `%1%'") % program); }); pipe.writeSide.close(); string result = drainFD(pipe.readSide); /* Wait for the child to finish. */ int status = pid.wait(true); if (!statusOk(status)) throw ExecError(format("program `%1%' %2%") % program % statusToString(status)); return result; } void closeMostFDs(const set<int> & exceptions) { int maxFD = 0; maxFD = sysconf(_SC_OPEN_MAX); for (int fd = 0; fd < maxFD; ++fd) if (fd != STDIN_FILENO && fd != STDOUT_FILENO && fd != STDERR_FILENO && exceptions.find(fd) == exceptions.end()) close(fd); /* ignore result */ } void closeOnExec(int fd) { int prev; if ((prev = fcntl(fd, F_GETFD, 0)) == -1 || fcntl(fd, F_SETFD, prev | FD_CLOEXEC) == -1) throw SysError("setting close-on-exec flag"); } ////////////////////////////////////////////////////////////////////// volatile sig_atomic_t _isInterrupted = 0; void _interrupted() { /* Block user interrupts while an exception is being handled. Throwing an exception while another exception is being handled kills the program! */ if (!std::uncaught_exception()) { _isInterrupted = 0; throw Interrupted("interrupted by the user"); } } ////////////////////////////////////////////////////////////////////// template<class C> C tokenizeString(const string & s, const string & separators) { C result; string::size_type pos = s.find_first_not_of(separators, 0); while (pos != string::npos) { string::size_type end = s.find_first_of(separators, pos + 1); if (end == string::npos) end = s.size(); string token(s, pos, end - pos); result.insert(result.end(), token); pos = s.find_first_not_of(separators, end); } return result; } template Strings tokenizeString(const string & s, const string & separators); template StringSet tokenizeString(const string & s, const string & separators); template vector<string> tokenizeString(const string & s, const string & separators); string concatStringsSep(const string & sep, const Strings & ss) { string s; foreach (Strings::const_iterator, i, ss) { if (s.size() != 0) s += sep; s += *i; } return s; } string concatStringsSep(const string & sep, const StringSet & ss) { string s; foreach (StringSet::const_iterator, i, ss) { if (s.size() != 0) s += sep; s += *i; } return s; } string chomp(const string & s) { size_t i = s.find_last_not_of(" \n\r\t"); return i == string::npos ? "" : string(s, 0, i + 1); } string statusToString(int status) { if (!WIFEXITED(status) || WEXITSTATUS(status) != 0) { if (WIFEXITED(status)) return (format("failed with exit code %1%") % WEXITSTATUS(status)).str(); else if (WIFSIGNALED(status)) { int sig = WTERMSIG(status); #if HAVE_STRSIGNAL const char * description = strsignal(sig); return (format("failed due to signal %1% (%2%)") % sig % description).str(); #else return (format("failed due to signal %1%") % sig).str(); #endif } else return "died abnormally"; } else return "succeeded"; } bool statusOk(int status) { return WIFEXITED(status) && WEXITSTATUS(status) == 0; } bool hasSuffix(const string & s, const string & suffix) { return s.size() >= suffix.size() && string(s, s.size() - suffix.size()) == suffix; } void expect(std::istream & str, const string & s) { char s2[s.size()]; str.read(s2, s.size()); if (string(s2, s.size()) != s) throw FormatError(format("expected string `%1%'") % s); } string parseString(std::istream & str) { string res; expect(str, "\""); int c; while ((c = str.get()) != '"') if (c == '\\') { c = str.get(); if (c == 'n') res += '\n'; else if (c == 'r') res += '\r'; else if (c == 't') res += '\t'; else res += c; } else res += c; return res; } bool endOfList(std::istream & str) { if (str.peek() == ',') { str.get(); return false; } if (str.peek() == ']') { str.get(); return true; } return false; } void ignoreException() { try { throw; } catch (std::exception & e) { printMsg(lvlError, format("error (ignored): %1%") % e.what()); } } static const string pathNullDevice = "/dev/null"; /* Common initialisation performed in child processes. */ void commonChildInit(Pipe & logPipe) { /* Put the child in a separate session (and thus a separate process group) so that it has no controlling terminal (meaning that e.g. ssh cannot open /dev/tty) and it doesn't receive terminal signals. */ if (setsid() == -1) throw SysError(format("creating a new session")); /* Dup the write side of the logger pipe into stderr. */ if (dup2(logPipe.writeSide, STDERR_FILENO) == -1) throw SysError("cannot pipe standard error into log file"); /* Dup stderr to stdout. */ if (dup2(STDERR_FILENO, STDOUT_FILENO) == -1) throw SysError("cannot dup stderr into stdout"); /* Reroute stdin to /dev/null. */ int fdDevNull = open(pathNullDevice.c_str(), O_RDWR); if (fdDevNull == -1) throw SysError(format("cannot open `%1%'") % pathNullDevice); if (dup2(fdDevNull, STDIN_FILENO) == -1) throw SysError("cannot dup null device into stdin"); close(fdDevNull); } ////////////////////////////////////////////////////////////////////// Agent::Agent(const string &command, const Strings &args, const std::map<string, string> &env) { debug(format("starting agent '%1%'") % command); /* Create a pipe to get the output of the child. */ fromAgent.create(); /* Create the communication pipes. */ toAgent.create(); /* Create a pipe to get the output of the builder. */ builderOut.create(); /* Fork the hook. */ pid = startProcess([&]() { commonChildInit(fromAgent); for (auto pair: env) { setenv(pair.first.c_str(), pair.second.c_str(), 1); } if (chdir("/") == -1) throw SysError("changing into `/"); /* Dup the communication pipes. */ if (dup2(toAgent.readSide, STDIN_FILENO) == -1) throw SysError("dupping to-hook read side"); /* Use fd 4 for the builder's stdout/stderr. */ if (dup2(builderOut.writeSide, 4) == -1) throw SysError("dupping builder's stdout/stderr"); Strings allArgs; allArgs.push_back(command); allArgs.insert(allArgs.end(), args.begin(), args.end()); // append execv(command.c_str(), stringsToCharPtrs(allArgs).data()); throw SysError(format("executing `%1%'") % command); }); pid.setSeparatePG(true); fromAgent.writeSide.close(); toAgent.readSide.close(); } Agent::~Agent() { try { toAgent.writeSide.close(); pid.kill(true); } catch (...) { ignoreException(); } } }
generated by cgit