diff options
Diffstat (limited to '')
| -rwxr-xr-x | scripts/reconfigure-system | 3 | ||||
| -rwxr-xr-x | scripts/reconfigure-user | 4 | ||||
| -rwxr-xr-x | scripts/update-commits | 268 |
3 files changed, 275 insertions, 0 deletions
diff --git a/scripts/reconfigure-system b/scripts/reconfigure-system new file mode 100755 index 0000000..1e38b42 --- /dev/null +++ b/scripts/reconfigure-system @@ -0,0 +1,3 @@ +#!/bin/sh +repo="$HOME/.config/guix" +sudo -E guix system -L "$repo/modules" reconfigure "$repo/systems/$(hostname).scm" diff --git a/scripts/reconfigure-user b/scripts/reconfigure-user new file mode 100755 index 0000000..3a0a602 --- /dev/null +++ b/scripts/reconfigure-user @@ -0,0 +1,4 @@ +#!/bin/sh +repo="$HOME/.config/guix" +guix home -L "$repo/modules" reconfigure "$repo/home/home.scm" +home-manager switch diff --git a/scripts/update-commits b/scripts/update-commits new file mode 100755 index 0000000..9302dcb --- /dev/null +++ b/scripts/update-commits @@ -0,0 +1,268 @@ +#!/run/current-system/profile/bin/guile -s +!# + +(use-modules (guix) + (guix channels) + (guix import json) + (guix git) + (ice-9 popen) + (ice-9 textual-ports) + (ice-9 pretty-print) + (srfi srfi-1)) ;; alist + +;; +;; config +;; + +(define %dotfiles-dir + (string-append + (getenv "HOME") + "/.config/guix")) + +(define %guix-channels-file + (string-append %dotfiles-dir "/channels.scm")) + +(define %nix-flake-file + (string-append %dotfiles-dir "/home/nix/flake.nix")) + +(define %guix-cuirass-servers + (list "https://cuirass.nonguix.org" + "https://cuirass.freya.cat")) + +;; +;; io functions +;; + +(define (invoke . args) + (let* ((command (string-join args " ")) + (err-cons (pipe)) + (port (with-error-to-port (cdr err-cons) + (lambda _ (open-input-pipe command)))) + (_ (setvbuf (car err-cons) 'block + (* 1024 16))) ; 16kib buffer + (result (get-string-all port))) + (close-port (cdr err-cons)) + result)) + +(define (read-file path) + (call-with-input-file path get-string-all)) + +(define (write-file path contents) + (call-with-output-file path (lambda (port) + (put-string port contents)))) + +;; +;; git functions +;; + +(define (git-checkout git-url) + ;; create or update a local bare git checkout from <git-url> + ;; - clones checkout if it doesnt exist + ;; - fetches newset commits + (let* ((home (getenv "HOME")) + (name (string-append + (string-replace-substring + (last (string-split git-url #\/)) + ".git" + "") + ".git")) + (dir (string-append home + "/.cache/checkouts/" + name))) + (if (not (access? dir F_OK)) + (begin + (format #t "checking out ~a...\n" name) + (invoke "mkdir" "-p" dir) + (invoke "git" "clone" "--bare" git-url dir))) + (invoke "git" "-C" dir "fetch") + dir)) + +(define (git-latest-commit git-url) + (car (string-split + (invoke "git" "ls-remote" git-url "HEAD") + #\tab))) + +(define (commit-timestamp git-url commit) + ; get the unix timestamp of a <commit> in git repo <git-url> + (let* ((dir (git-checkout git-url)) + (timestamp + (invoke "git" "-C" dir "show" "--quiet" "--format=%at" commit))) + (string->number (string-trim-both timestamp #\newline)))) + +;; +;; core functions +;; + +(define (merge-commits local-commits remote-commits) + ;; create a zipped pair of each <loacl> and <remote> commits + ;; - ignores the commit if the remote its older than the local commit + ;; + ;; local commit format: + ;; ('id "git-url" "commit") + ;; + ;; remote commit format: + ;; ('id . "commit") + ;; + ;; return format: + ;; ('id "local-commit" "newest-commit") ;; neweset commit is commit with + ;; ;; newer timestamp + (fold (lambda (local-repo commits) + (let* ((repo-id (car local-repo)) + (git-url (cadr local-repo)) + ; local + (local-commit (caddr local-repo)) + (local-timestamp (commit-timestamp git-url local-commit)) + ; remote + (remote-commit (assoc-ref remote-commits repo-id)) + (remote-timestamp (if (string? remote-commit) + (commit-timestamp git-url remote-commit))) + ; newest + (newest-commit (if (and (number? remote-timestamp) + (> remote-timestamp local-timestamp)) + remote-commit)) + ; result + (result (if (string? newest-commit) + (cons (list repo-id local-commit newest-commit) + commits) + commits))) + result)) + '() + local-commits)) + +(define (update-file local-commits remote-commits path) + (let* ((contents (read-file path)) + (commits (merge-commits local-commits remote-commits)) + (result (fold (lambda (pair contents) + (let ((repo-id (car pair)) + (local-commit (cadr pair)) + (remote-commit (caddr pair))) + (format #t "~s\t~a -> ~a\n" + repo-id + (string-take local-commit 7) + (string-take remote-commit 7)) + (string-replace-substring contents + local-commit + remote-commit))) + (read-file path) + commits))) + (write-file path result))) + +;; +;; guix functions +;; + +(define (cuirass-latest-evaluation cuirass-url) + (json-fetch + (string-append + cuirass-url + "/api/evaluations?nr=1"))) + +(define (guix-local-commits channels) + (map (lambda (channel) + (list (channel-name channel) + (channel-url channel) + (channel-commit channel))) + channels)) + +(define (cuirass-commits cuirass-servers) + (fold (lambda (cuirass-url env) + (let* ((evaluation (cuirass-latest-evaluation cuirass-url)) + (checkouts (vector->list + (assoc-ref + (car (vector->list evaluation)) + "checkouts")))) + (fold (lambda (checkout env) + (let* ((channel (string->symbol + (assoc-ref checkout "channel"))) + (commit (assoc-ref checkout "commit"))) + (if (assoc-ref env channel) + ;; channel already set, skip + env + ;; add commit to env + (assoc-set! env channel commit)))) + env + checkouts))) + '() + cuirass-servers)) + +;; +;; nix functions +;; + +(define (nix-local-commits flake-file) + (let ((lines (filter + (lambda (line) + (string-contains line "github:")) + (string-split (read-file flake-file) + #\newline)))) + (map + ;; valid line, parse out repo-id, git-url, and commit + (lambda (line) + (let* ((trimmed (substring line + (+ (string-index line #\:) 1) + (string-rindex line #\"))) + (pair (string-split trimmed #\/)) + (repo-id (string->symbol (cadr pair))) + (git-url (string-append "https://github.com/" + (car pair) "/" + (cadr pair) ".git")) + (commit (caddr pair))) + (list repo-id git-url commit))) + lines))) + +(define (nix-nixpkgs-commit) + (let ((json (json-fetch + (string-append + "https://raw.githubusercontent.com/" + "nix-community/home-manager" + "/refs/heads/master/flake.lock") + #:timeout 1))) + (fold + (lambda (key json) + (assoc-ref json key)) + json + (list "nodes" + "nixpkgs" + "locked" + "rev")))) + +(define (nix-remote-commits local-commits) + (fold (lambda (pair env) + (let* ((repo-id (car pair)) + (git-url (cadr pair)) + (commit (if (eq? repo-id 'nixpkgs) + (nix-nixpkgs-commit) + (git-latest-commit git-url)))) + (assoc-set! env repo-id commit))) + '() + local-commits)) + +;; +;; update +;; + +(define %guix-local-commits + (guix-local-commits + (load %guix-channels-file))) + +(define %guix-remote-commits + (cuirass-commits %guix-cuirass-servers)) + +(define %nix-local-commits + (nix-local-commits %nix-flake-file)) + +(define %nix-remote-commits + (nix-remote-commits %nix-local-commits)) + +(update-file + %guix-local-commits + %guix-remote-commits + %guix-channels-file) + +(update-file + %nix-local-commits + %nix-remote-commits + %nix-flake-file) + +(system* "guix" "pull" "-C" %guix-channels-file) +(system* "nix" "flake" "lock" (dirname %nix-flake-file)) |