;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- (declaim (optimize (speed 0) (safety 3) (debug 3))) (in-package :snow) (defun shell-wrapper-as-string (command) (multiple-value-bind (outlist return-code) (org-ckons-core::shell-wrapper command) (values (ppcre:regex-replace-all (format nil "~a" #\Return) (org-ckons-core::reduce-to-newline-separated-string outlist) (format nil "~a" #\Newline)) return-code))) (defclass git () ((stdout :initarg :stdout :initform nil :accessor stdout) (pwd :initarg :pwd :initform (sb-ext:posix-getenv "OLO_PROJECT_HOME") :accessor pwd) (exclude-dirs :initarg :exclude-dirs :initform (getf (getf (queue (get-webapp "snow")) :git) :exclude-dirs) :accessor exclude-dirs)) (:documentation "")) (defclass git-update (git) () (:documentation "")) (defclass git-update-task (git-update) ((remote :initarg :remote :initform nil :accessor remote)) (:documentation "")) (defmethod bg-perform ((git-update git-update)) (let ((output (make-array '(0) :element-type 'character :fill-pointer 0 :adjustable t)) (github-orgs '("ololabs" "ololabs-geo" "omnivore")) (all-locals-command (format nil "cd ~a ; find . -maxdepth 2 -type d" (pwd git-update))) all-remotes all-remote-dirs all-locals) (loop for org in github-orgs do (org-ckons-core::add-to-list all-remotes (sort (remove-if (lambda (item) (or (org-ckons-core::match-it "CDN.git" item) (org-ckons-core::match-it "terraform-github-import-playground.git" item) (org-ckons-core::match-it "MvvmCross.git" item))) (loop for remote in (org-ckons-core::shell-wrapper (format nil "gh repo list ~a -L 9999 --no-archived --json sshUrl | jq -M '.[].sshUrl'" org)) collect (ppcre:regex-replace-all "\"" remote ""))) 'string<)) (org-ckons-core::add-to-list all-remote-dirs (loop for remote in all-remotes collect (subseq remote 15 (- (length remote) 4)))) (org-ckons-core::add-to-list all-locals (sort (set-difference (loop for dir in (org-ckons-core::shell-wrapper all-locals-command) when (org-ckons-core::match-it "^\./.*/.*$" dir) collect (subseq dir 2)) (exclude-dirs git-update) :test 'string=) 'string<))) (with-output-to-string (stream output) (if all-remotes (progn (format stream "~a~%~%~%" all-remotes) (loop for dir in (set-difference all-remote-dirs all-locals :test 'string=) do (format stream "Deleting ~a/~a~%" (pwd git-update) dir) (org-ckons-core::shell-wrapper (format nil "rm -rf ~a/~a~%" (pwd git-update) dir))) (loop for remote in all-remotes do (enqueue *queue-git* (make-instance 'git-update-task :stdout (stdout git-update) :remote remote))) (format stream "~%~%~%")) (format stream "No remotes found. Something went wrong. Aborting.~%"))) (with-open-file (stream (stdout git-update) :direction :output :if-exists :append :if-does-not-exist :create) (format stream output)))) (defmethod update-git ((git-update git-update)) (enqueue *queue-git* git-update)) (defmethod bg-perform ((git-update-task git-update-task)) (let* ((output (make-array '(0) :element-type 'character :fill-pointer 0 :adjustable t)) (fulldir (subseq (remote git-update-task) 15 (- (length (remote git-update-task)) 4))) (org (first (ppcre:split "/" fulldir))) (status-command (format nil "cd ~a/~a ; git status" (pwd git-update-task) fulldir)) (fetch-command (format nil "cd ~a/~a ; git fetch --prune" (pwd git-update-task) fulldir)) (branch-command (format nil "cd ~a/~a ; PAGER=cat git branch | grep -F '*' | awk '{print $2}'" (pwd git-update-task) fulldir)) (clone-command (format nil "cd ~a ; mkdir -p ~a ; cd ~a ; gh repo clone ~a" (pwd git-update-task) org org fulldir))) (with-output-to-string (stream output) (if (probe-file (format nil "~a/~a" (pwd git-update-task) fulldir)) (progn (format stream "Checking ~a~%" fulldir) (multiple-value-bind (stdout return-code) (shell-wrapper-as-string status-command) (format stream "~a~%" stdout) (when (= return-code 0) (format stream (shell-wrapper-as-string fetch-command)) (let ((branch (string-trim '(#\Space #\Tab #\Newline) (shell-wrapper-as-string branch-command)))) (if (position branch '("main" "develop" "development" "master") :test 'string=) (progn (format stream "Updating repo ~a on branch ~a~%" fulldir branch) (format stream (shell-wrapper-as-string (format nil "cd ~a/~a ; git pull origin ~a" (pwd git-update-task) fulldir branch)))) (format stream "~a not pulled because it is on branch ~a~%" fulldir branch)))))) (progn (format stream "Cloning ~a~%" fulldir) (format stream (shell-wrapper-as-string clone-command)))) (format stream "~%~%~%")) (with-open-file (stream (stdout git-update-task) :direction :output :if-exists :append :if-does-not-exist :create) (format stream output))))