Commit 587db331 authored by Eric Timmons's avatar Eric Timmons
Browse files

Handle *FETCH-REPO-AUTOMATICALLY* more sanely

parent 306b38a9
...@@ -80,8 +80,7 @@ ...@@ -80,8 +80,7 @@
"Given a clpmfile instance, install all releases from its lock file, creating "Given a clpmfile instance, install all releases from its lock file, creating
the lock file if necessary." the lock file if necessary."
(with-bundle-session (clpmfile) (with-bundle-session (clpmfile)
(let* ((*fetch-repo-automatically* (not (config-value :local))) (let* ((clpmfile (get-clpmfile clpmfile))
(clpmfile (get-clpmfile clpmfile))
(lockfile-pathname (clpmfile-lockfile-pathname clpmfile)) (lockfile-pathname (clpmfile-lockfile-pathname clpmfile))
(lockfile nil) (lockfile nil)
(changedp nil)) (changedp nil))
...@@ -112,8 +111,7 @@ the lock file if necessary." ...@@ -112,8 +111,7 @@ the lock file if necessary."
(defun bundle-source-registry (&key clpmfile with-client-p ignore-missing-releases) (defun bundle-source-registry (&key clpmfile with-client-p ignore-missing-releases)
(with-bundle-session (clpmfile) (with-bundle-session (clpmfile)
(with-sources-using-installed-only () (with-sources-using-installed-only ()
(let* ((*fetch-repo-automatically* nil) (let* ((lockfile-pathname (clpmfile-lockfile-pathname clpmfile))
(lockfile-pathname (clpmfile-lockfile-pathname clpmfile))
(*vcs-project-override-fun* (make-vcs-override-fun (clpmfile-pathname clpmfile))) (*vcs-project-override-fun* (make-vcs-override-fun (clpmfile-pathname clpmfile)))
lockfile) lockfile)
(unless (probe-file lockfile-pathname) (unless (probe-file lockfile-pathname)
...@@ -134,8 +132,7 @@ the lock file if necessary." ...@@ -134,8 +132,7 @@ the lock file if necessary."
update-projects (validate (constantly t)) update-projects (validate (constantly t))
update-systems) update-systems)
(with-bundle-session (clpmfile) (with-bundle-session (clpmfile)
(let* ((*fetch-repo-automatically* (not (config-value :local))) (let* ((clpmfile (get-clpmfile clpmfile))
(clpmfile (get-clpmfile clpmfile))
(lockfile-pathname (clpmfile-lockfile-pathname clpmfile)) (lockfile-pathname (clpmfile-lockfile-pathname clpmfile))
(*vcs-project-override-fun* (make-vcs-override-fun (clpmfile-pathname clpmfile))) (*vcs-project-override-fun* (make-vcs-override-fun (clpmfile-pathname clpmfile)))
(lockfile nil) (lockfile nil)
...@@ -180,8 +177,7 @@ If WITH-CLIENT-P is non-NIL, the clpm-client system is available." ...@@ -180,8 +177,7 @@ If WITH-CLIENT-P is non-NIL, the clpm-client system is available."
(error "COMMAND must be a string.")) (error "COMMAND must be a string."))
(with-bundle-session (clpmfile) (with-bundle-session (clpmfile)
(with-sources-using-installed-only () (with-sources-using-installed-only ()
(let* ((*fetch-repo-automatically* nil) (let* ((clpmfile-pathname (clpmfile-pathname clpmfile))
(clpmfile-pathname (clpmfile-pathname clpmfile))
(lockfile-pathname (clpmfile-lockfile-pathname clpmfile)) (lockfile-pathname (clpmfile-lockfile-pathname clpmfile))
(lockfile (load-lockfile lockfile-pathname)) (lockfile (load-lockfile lockfile-pathname))
(cl-source-registry-form (context-to-asdf-source-registry-form lockfile (cl-source-registry-form (context-to-asdf-source-registry-form lockfile
......
...@@ -8,6 +8,7 @@ ...@@ -8,6 +8,7 @@
#:alexandria #:alexandria
#:clpm/archives #:clpm/archives
#:clpm/cache #:clpm/cache
#:clpm/config
#:clpm/http-client #:clpm/http-client
#:clpm/log #:clpm/log
#:clpm/repos/defs #:clpm/repos/defs
...@@ -226,13 +227,14 @@ ref is present locally, fetching or cloning the repo as necessary." ...@@ -226,13 +227,14 @@ ref is present locally, fetching or cloning the repo as necessary."
(when (and (or (eql ref-type :branch) (when (and (or (eql ref-type :branch)
(starts-with-subseq "refs/heads/" ref-name) (starts-with-subseq "refs/heads/" ref-name)
(not (ref-present-p repo ref))) (not (ref-present-p repo ref)))
(not (config-value :local))
*fetch-repo-automatically*) *fetch-repo-automatically*)
(with-retries (:max 10 :sleep 5) (with-retries (:max 10 :sleep 5)
(fetch-repo! repo)) (fetch-repo! repo))
;; Make sure the ref is actually present, raising an error otherwise. ;; Make sure the ref is actually present, raising an error otherwise.
(unless (ref-present-p repo ref) (unless (ref-present-p repo ref)
(error "ref ~S is not present" ref)))) (error "ref ~S is not present" ref))))
(*fetch-repo-automatically* ((and (not (config-value :local)) *fetch-repo-automatically*)
;; Repo is not present at all, need to clone it. ;; Repo is not present at all, need to clone it.
(with-retries (:max 10 :sleep 5) (with-retries (:max 10 :sleep 5)
(clone-repo! repo) (clone-repo! repo)
......
...@@ -7,6 +7,7 @@ ...@@ -7,6 +7,7 @@
(:use #:cl (:use #:cl
#:alexandria #:alexandria
#:clpm/config #:clpm/config
#:clpm/repos/defs
#:clpm/sources/clpi #:clpm/sources/clpi
#:clpm/sources/defs #:clpm/sources/defs
#:clpm/sources/fs #:clpm/sources/fs
...@@ -39,7 +40,8 @@ ...@@ -39,7 +40,8 @@
(defvar *sources-use-installed-only-p* nil) (defvar *sources-use-installed-only-p* nil)
(defun call-with-sources-using-installed-only (thunk) (defun call-with-sources-using-installed-only (thunk)
(let ((*sources-use-installed-only-p* t)) (let ((*sources-use-installed-only-p* t)
(*fetch-repo-automatically* nil))
(funcall thunk))) (funcall thunk)))
(defmacro with-sources-using-installed-only (() &body body) (defmacro with-sources-using-installed-only (() &body body)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment