Merge branch 'master' into core-updates

3 files changed, 27 insertions, 74 deletions

diff --git a/guix/build/download.scm b/guix/build/download.scm
index 1b630a9d6d..315a3554ec 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
@@ -321,14 +321,6 @@ host name without trailing dot."
    ((uri? uri-or-string) uri-or-string)
    (else (error "Invalid URI" uri-or-string))))
 
-(define current-http-proxy
-  ;; XXX: Add a dummy definition for Guile < 2.0.10; this is used in
-  ;; 'open-socket-for-uri'.
-  (or (and=> (module-variable (resolve-interface '(web client))
-                              'current-http-proxy)
-             variable-ref)
-      (const #f)))
-
 (define* (open-socket-for-uri uri-or-string #:key timeout)
   "Return an open input/output port for a connection to URI.  When TIMEOUT is
 not #f, it must be a (possibly inexact) number denoting the maximum duration
diff --git a/guix/build/git.scm b/guix/build/git.scm
index c1af545a76..14d415a6f8 100644
--- a/guix/build/git.scm
+++ b/guix/build/git.scm
@@ -37,28 +37,31 @@ recursively.  Return #t on success, #f otherwise."
   ;; in advance anyway.
   (setenv "GIT_SSL_NO_VERIFY" "true")
 
-  ;; We cannot use "git clone --recursive" since the following "git checkout"
-  ;; effectively removes sub-module checkouts as of Git 2.6.3.
-  (and (zero? (system* git-command "clone" url directory))
-       (with-directory-excursion directory
-         (system* git-command "tag" "-l")
-         (and (zero? (system* git-command "checkout" commit))
-              (begin
-                (when recursive?
-                  ;; Now is the time to fetch sub-modules.
-                  (unless (zero? (system* git-command "submodule" "update"
+  (mkdir-p directory)
+
+  (with-directory-excursion directory
+    (invoke git-command "init")
+    (invoke git-command "remote" "add" "origin" url)
+    (if (zero? (system* git-command "fetch" "--depth" "1" "origin" commit))
+        (invoke git-command "checkout" "FETCH_HEAD")
+        (begin
+          (invoke git-command "fetch" "origin")
+          (invoke git-command "checkout" commit)))
+    (when recursive?
+      ;; Now is the time to fetch sub-modules.
+      (unless (zero? (system* git-command "submodule" "update"
                                           "--init" "--recursive"))
-                    (error "failed to fetch sub-modules" url))
+        (error "failed to fetch sub-modules" url))
 
-                  ;; In sub-modules, '.git' is a flat file, not a directory,
-                  ;; so we can use 'find-files' here.
-                  (for-each delete-file-recursively
-                            (find-files directory "^\\.git$")))
+      ;; In sub-modules, '.git' is a flat file, not a directory,
+      ;; so we can use 'find-files' here.
+      (for-each delete-file-recursively
+                (find-files directory "^\\.git$")))
 
-                ;; The contents of '.git' vary as a function of the current
-                ;; status of the Git repo.  Since we want a fixed output, this
-                ;; directory needs to be taken out.
-                (delete-file-recursively ".git")
-                #t)))))
+      ;; The contents of '.git' vary as a function of the current
+      ;; status of the Git repo.  Since we want a fixed output, this
+      ;; directory needs to be taken out.
+      (delete-file-recursively ".git")
+      #t))
 
 ;;; git.scm ends here
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 0cb630cfb3..25726b885e 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
@@ -350,39 +350,6 @@ expansion-time error is raised if FIELD does not exist in TYPE."
 ;;; FFI.
 ;;;
 
-(define %libc-errno-pointer
-  ;; Glibc's 'errno' pointer, for use with Guile < 2.0.12.
-  (let ((errno-loc (false-if-exception
-                    (dynamic-func "__errno_location" (dynamic-link)))))
-    (and errno-loc
-         (let ((proc (pointer->procedure '* errno-loc '())))
-           (proc)))))
-
-(define errno                                     ;for Guile < 2.0.12
-  (if %libc-errno-pointer
-      (let ((bv (pointer->bytevector %libc-errno-pointer (sizeof int))))
-        (lambda ()
-          "Return the current errno."
-          ;; XXX: We assume that nothing changes 'errno' while we're doing all this.
-          ;; In particular, that means that no async must be running here.
-
-          ;; Use one of the fixed-size native-ref procedures because they are
-          ;; optimized down to a single VM instruction, which reduces the risk
-          ;; that we fiddle with 'errno' (needed on Guile 2.0.5, libc 2.11.)
-          (let-syntax ((ref (lambda (s)
-                              (syntax-case s ()
-                                ((_ bv)
-                                 (case (sizeof int)
-                                   ((4)
-                                    #'(bytevector-s32-native-ref bv 0))
-                                   ((8)
-                                    #'(bytevector-s64-native-ref bv 0))
-                                   (else
-                                    (error "unsupported 'int' size"
-                                           (sizeof int)))))))))
-            (ref bv))))
-      (lambda () 0)))
-
 (define (call-with-restart-on-EINTR thunk)
   (let loop ()
     (catch 'system-error
@@ -406,17 +373,8 @@ the returned procedure is called."
     (lambda ()
       (let ((ptr (dynamic-func name (dynamic-link))))
         ;; The #:return-errno? facility was introduced in Guile 2.0.12.
-        ;; Support older versions of Guile by catching 'wrong-number-of-args'.
-        (catch 'wrong-number-of-args
-          (lambda ()
-            (pointer->procedure return-type ptr argument-types
-                                #:return-errno? #t))
-          (lambda (key . rest)
-            (let ((proc (pointer->procedure return-type ptr argument-types)))
-              (lambda args
-                (let ((result (apply proc args))
-                      (err    (errno)))
-                  (values result err))))))))
+        (pointer->procedure return-type ptr argument-types
+                            #:return-errno? #t)))
     (lambda args
       (lambda _
         (error (format #f "~a: syscall->procedure failed: ~s"