diff --git a/Dockerfile b/Dockerfile index 9bd9aee..24ebdfb 100644 --- a/Dockerfile +++ b/Dockerfile @@ -1,27 +1,28 @@ FROM debian:11 RUN export DEBIAN_FRONTEND=noninteractive && \ apt-get update && apt-get upgrade -y && \ apt-get install -y \ cl-quicklisp \ default-libmysqlclient-dev \ - git + git \ + kubernetes-client RUN mkdir -p /srv/phabricator /opt/forgerie RUN useradd -md /srv/forgerie -s /bin/bash forgerie COPY docker/.sbclrc /srv/forgerie/.sbclrc RUN chown -R forgerie:forgerie /srv/forgerie /opt/forgerie USER forgerie WORKDIR /srv/forgerie # install quicklisp and pulls core dependencies for it to run properly RUN sbcl --no-sysinit --no-userinit --noprint \ --load /usr/share/common-lisp/source/quicklisp/quicklisp.lisp \ --eval '(quicklisp-quickstart:install :path "quicklisp")' \ --quit # to install and configure quicklisp COPY . /opt/forgerie ENV FORGERIE_PATH=/opt/forgerie/ # install quicklisp and pulls core dependencies for it to run properly RUN sbcl --quit diff --git a/bin/build-config-tmpl b/bin/build-config-tmpl index 3cc87b7..489204a 100755 --- a/bin/build-config-tmpl +++ b/bin/build-config-tmpl @@ -1,72 +1,73 @@ #!/usr/bin/env -S /usr/bin/sbcl --script (let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))) (when (probe-file quicklisp-init) (load quicklisp-init))) ;; Make sure we can provide path to forgerie code... (let ((forgerie-path (uiop:getenv "FORGERIE_PATH"))) (when (and forgerie-path (probe-file forgerie-path)) (push (pathname forgerie-path) asdf:*central-registry*))) ;; so quicklisp is able to run the forgerie code and execute the script (ql:quickload :forgerie) (with-open-file (str "config/config.lisp.tmpl" :direction :output :if-exists :supersede) (format str ";;;; This template file is generated by bin/build-config-templ and should not be edited manually. ;;;; ;;;; Install by copying to config.lisp~%~%") (mapcar (lambda (section) (format str ";;;;;;;;;;;;;;;;;;;~%;;; ~A~%;;;;;;;;;;;;;;;;;;;~%~%" (car section)) (mapcar (lambda (variable-def) (let ((variable-name (if (listp variable-def) (car variable-def) variable-def)) (default (if (listp variable-def) (cadr variable-def) "nil"))) (format str "~{;~A~%~}(setf ~(~A~):~(~A~) ~A)~%~%" (mapcar (lambda (line) (if (< 0 (length line)) (cl-ppcre:regex-replace-all "^ ?" line " ") "")) (cl-ppcre:split "\\n" (documentation variable-name 'variable))) (package-name (symbol-package variable-name)) (symbol-name variable-name) default ))) (cdr section))) '(("system" (sb-impl::*default-external-format* ":UTF-8") (drakma:*drakma-default-external-format* "'UTF-8")) ("core" forgerie-core:*debug* forgerie-core:*log-mapping-errors* forgerie-core:*working-directory*) ("phabricator" forgerie-phabricator:*database-password* forgerie-phabricator:*database-username* forgerie-phabricator:*revisions-to-skip* forgerie-phabricator:*phabricator-location* forgerie-phabricator:*project-assignment-overrides* forgerie-phabricator:*repository-overrides* forgerie-phabricator:*pastes-to-skip* forgerie-phabricator:*user-overrides* forgerie-phabricator:*storage-location* forgerie-phabricator:*confidential-space-phids* forgerie-phabricator:*included-repositories* forgerie-phabricator:*staging-repository* forgerie-phabricator:*email-address-sanitizer*) ("gitlab" forgerie-gitlab:*private-token* forgerie-gitlab:*server-address* forgerie-gitlab:*default-project* forgerie-gitlab:*ssh-public-key* forgerie-gitlab:*default-group* - forgerie-gitlab:*rails-console-ssh-args* + forgerie-gitlab:*rails-command* + forgerie-gitlab:*rails-command-args* forgerie-gitlab:*merge-request-suffix* forgerie-gitlab:*ticket-suffix* forgerie-gitlab:*limit-to-active-users*)))) diff --git a/config/config.lisp.tmpl b/config/config.lisp.tmpl index 07b0cc6..2f350d7 100644 --- a/config/config.lisp.tmpl +++ b/config/config.lisp.tmpl @@ -1,171 +1,182 @@ ;;;; This template file is generated by bin/build-config-templ and should not be edited manually. ;;;; ;;;; Install by copying to config.lisp ;;;;;;;;;;;;;;;;;;; ;;; system ;;;;;;;;;;;;;;;;;;; (setf sb-ext:*default-external-format* :UTF-8) ; The default value for the external format keyword arguments of ; HTTP-REQUEST. The value of this variable will be interpreted by ; FLEXI-STREAMS. The initial value is the keyword :LATIN-1. ; (Note that Drakma binds *DEFAULT-EOL-STYLE* to :LF). (setf drakma:*drakma-default-external-format* 'UTF-8) ;;;;;;;;;;;;;;;;;;; ;;; core ;;;;;;;;;;;;;;;;;;; ; Set to T to enable output of trace level messaging, such ; as http requests, git commands, and database queries (setf forgerie-core:*debug* nil) ; Boolean which indicates whether mapping errors should be logged. Defaults ; to T to create a mapping errors file that can be later used to output ; what errors the run ran into. (setf forgerie-core:*log-mapping-errors* nil) ; The working directory for the run. Core files will be put into ; 'core' underneath this, and then each forgerie will base on this. (setf forgerie-core:*working-directory* nil) ;;;;;;;;;;;;;;;;;;; ;;; phabricator ;;;;;;;;;;;;;;;;;;; ; Password to access the mysql database. If NIL, will not enter password (setf forgerie-phabricator:*database-password* nil) ; Username to access the database. If NIL, will use the current user (setf forgerie-phabricator:*database-username* nil) ; List of revisions to skip. For instance, if they cause errors due to weird git ; history. They need to be handled manually. The list is of database ids. (setf forgerie-phabricator:*revisions-to-skip* nil) ; The HTTP location of the phabricator instance. This is only used for ; differentials that cannot be understood via the database. The raw diffs ; for these are pulled from the instance, and so they need to be accessible ; from the script. (setf forgerie-phabricator:*phabricator-location* nil) ; A list of plists of override commands for projects. Each item in the list is of the form ; '(:key KEY :repository SLUG) ; ; Where the KEY is the database id of the project, and the SLUG is which repository that this ; project should be a primary project of. Then the project will be removed from all other -; repositories it might be assigned to. The ramification of this is that tasks that are +; repositories it mgiht be assigned to. The ramification of this is that tasks that are ; part of this project, for instance, will be assigned to the repository in various forgeries ; that link project and repository. (setf forgerie-phabricator:*project-assignment-overrides* nil) ; A list of plists for overriding certain features of projects. The plists are of the form ; '(:key KEY :action ACTION) ; ; Where KEY is the id of the database. ACTION can be either :skip or :update. ; - :skip, the repository will be skipped (useful for things like the staging repository) ; - :update, will be require a further item :DATA which is a plist of overrides corresponding ; to database fields for the repository table. Useful when renaming items, or specifying ; slugs. (setf forgerie-phabricator:*repository-overrides* nil) ; Pastes that can't be migrated, and will need to be handled manually. This is a list of ; database ids. They need to be handled manually. (setf forgerie-phabricator:*pastes-to-skip* nil) ; A list of plists for overriding certain features of users. The plists are of the form ; '(:key KEY :action ACTION) ; ; Where KEY is the id of the database. ACTION can be only :update. ; - :update, will be require a further item :DATA which is a plist of overrides corresponding ; to database fields for the user table. Useful when renaming user names, or specifying ; other aspects of the user. (setf forgerie-phabricator:*user-overrides* nil) ; The path on the local file system for the local storage of files. The phabricator_file ; database can refer to local storage items, which are stored here (other options being ; that the file is stored in the database). (setf forgerie-phabricator:*storage-location* nil) ; List of spaces that should be marked as confidential on the export. (setf forgerie-phabricator:*confidential-space-phids* nil) ; When doing only a partial import, use to list which slugs to be imported. ; ; This means that any tasks will be not mappable to a repository, and may end up in the ; default project of the exporter, so when using this, you'll want to disable that feature ; in the exporter of choice (setf forgerie-phabricator:*included-repositories* nil) ; PHID of the staging repository, if used. If NIL, commits for differentials will ; not be extracted from staging. Used if set up with arcanist. (setf forgerie-phabricator:*staging-repository* nil) ; A function that takes a string representing an email address, and then returns ; one that should be used in its place. Used in testing mode to ensure that ; users aren't getting random emails from the export forgerie, as an extra precaution. (setf forgerie-phabricator:*email-address-sanitizer* nil) ;;;;;;;;;;;;;;;;;;; ;;; gitlab ;;;;;;;;;;;;;;;;;;; ; The private token with which to access the gitlab instance. Needs to be ; set up either from within gitlab, or via a script that uses the rails console ; directory (setf forgerie-gitlab:*private-token* nil) ; The fully qualitifed server address for the gitlab instance, including the scheme to ; use, e.g. https://gitlab.yourdomain.tld (setf forgerie-gitlab:*server-address* nil) ; A plist of the form '(:name NAME :slug SLUG) for the default project ; in which things like snippets, tickets that can't be assigned to a project, ; and other misc items go. NAME is the proper name of the project, with ; SLUG being the url slug to access it. (setf forgerie-gitlab:*default-project* nil) ; The public key that should be installed for the running user so that git commands ; work correctly. (setf forgerie-gitlab:*ssh-public-key* nil) ; A plist of the form '(:name NAME :path SLUG) that defines the group in which ; all created projects will be placed. NAME is the proper name for the group, ; while SLUG is the url slug. If NIL, the projects will all be created at the ; top level. (setf forgerie-gitlab:*default-group* nil) -; A tuple of the form '(HOST COMMAND) that informs the gitlab forgerie -; how to run rails commands over ssh. It will always use SSH, even if -; set up to run on localhost, so keys must be installed to ssh to localhost. +; The rails command to execute, by default this uses ssh. But one could use kubectl or +; docker instead. +(setf forgerie-gitlab:*rails-command* nil) + +; By default, using ssh, a tuple of the form '(HOST COMMAND) that informs the gitlab +; forgerie how to run rails commands over ssh. It will always use SSH, even if set up to +; run on localhost, so keys must be installed to ssh to localhost. When overriden to +; another command like kubectl, a list '(COMMAND) for the necessary extra args that the +; command requires to run. ; -; An example for a server using docker might be: +; When using ssh, an example for a server using docker might be: ; ; '("ssh.gitlab.yourdomain.tld" "docker exec -i gitlab /opt/gitlab/bin/gitlab-rails c") ; -; A useful thing to do is to run ssh on the server for non git purposes on port 2222, and then -; set up your .ssh/config to have the following: +; A useful thing to do is to run ssh on the server for non git purposes on port 2222, and +; then set up your .ssh/config to have the following: ; ; Host ssh.gitlab.yourdomain.tld ; User ; Port 2222 ; IdentityFile ~/.ssh/your_identity_file -(setf forgerie-gitlab:*rails-console-ssh-args* nil) +; +; When using kube, an example might be: +; +; '("exec -ti -n gitlab-system deployment/gitlab-toolbox -- /srv/gitlab/bin/rails console") +(setf forgerie-gitlab:*rails-command-args* nil) ; A function that takes an argument of a forgerie-core:merge-request and ; returns a string that will be appended to the description of created merge requests. ; ; Useful to create backlinks to the previous system, or addition migration information (setf forgerie-gitlab:*merge-request-suffix* nil) ; A function that takes an argument of a forgerie-core:ticket and ; returns a string that will be appended to the description of created tickets (issues). ; ; Useful to create backlinks to the previous system, or addition migration information (setf forgerie-gitlab:*ticket-suffix* nil) ; If non nil, will only add users to the gitlab instance if they are active in the ; items also coming over for processing. Useful when doing piecemeal conversions. (setf forgerie-gitlab:*limit-to-active-users* nil) + diff --git a/src/main/gitlab/base.lisp b/src/main/gitlab/base.lisp index b3409af..3ffe823 100644 --- a/src/main/gitlab/base.lisp +++ b/src/main/gitlab/base.lisp @@ -1,68 +1,79 @@ (in-package #:forgerie-gitlab) (defvar *server-address* nil "The fully qualitifed server address for the gitlab instance, including the scheme to use, e.g. https://gitlab.yourdomain.tld") (defvar *private-token* nil "The private token with which to access the gitlab instance. Needs to be set up either from within gitlab, or via a script that uses the rails console directory") (defvar *default-project* nil "A plist of the form '(:name NAME :slug SLUG :disable-tickets DISABLE) for the default project in which things like snippets, tickets that can't be assigned to a project, and other misc items go. NAME is the proper name of the project, with SLUG being the url slug to access it. If DISABLE is set to T, then tickets that can't be assigned to a project will not be assigned to this default project.") (defvar *ssh-public-key* nil "The public key that should be installed for the running user so that git commands work correctly.") (defvar *default-group* nil "A plist of the form '(:name NAME :path SLUG) that defines the group in which all created projects will be placed. NAME is the proper name for the group, while SLUG is the url slug. If NIL, the projects will all be created at the top level.") ; For development only. Will limit all exporting to things having ; to do with the project with the name provided. (defvar *single-project* nil) -; The args (host and command are normal) for the ssh command to -; boot the rails console. Sometimes this is localhost. Keys -; have to be set up. -(defvar *rails-console-ssh-args* nil - "A tuple of the form '(HOST COMMAND) that informs the gitlab forgerie - how to run rails commands over ssh. It will always use SSH, even if - set up to run on localhost, so keys must be installed to ssh to localhost. +; The default rails-command to execute the rails console. +(defvar *rails-command* "/usr/bin/ssh" + "The rails command to execute, by default this uses ssh. But one could use kubectl or +docker instead.") - An example for a server using docker might be: +; The required args for the *rails-command*. +(defvar *rails-command-args* nil + "By default, using ssh, a tuple of the form '(HOST COMMAND) that informs the gitlab + forgerie how to run rails commands over ssh. It will always use SSH, even if set up to + run on localhost, so keys must be installed to ssh to localhost. When overriden to + another command like kubectl, a list '(COMMAND) for the necessary extra args that the + command requires to run. + + When using ssh, an example for a server using docker might be: '(\"ssh.gitlab.yourdomain.tld\" \"docker exec -i gitlab /opt/gitlab/bin/gitlab-rails c\") - A useful thing to do is to run ssh on the server for non git purposes on port 2222, and then - set up your .ssh/config to have the following: + A useful thing to do is to run ssh on the server for non git purposes on port 2222, and + then set up your .ssh/config to have the following: Host ssh.gitlab.yourdomain.tld User Port 2222 - IdentityFile ~/.ssh/your_identity_file") + IdentityFile ~/.ssh/your_identity_file + + When using kube, an example might be: + + '(\"exec -ti -n gitlab-system deployment/gitlab-toolbox -- /srv/gitlab/bin/rails console\") + +") (defvar *merge-request-suffix* nil "A function that takes an argument of a forgerie-core:merge-request and returns a string that will be appended to the description of created merge requests. Useful to create backlinks to the previous system, or addition migration information") (defvar *ticket-suffix* nil "A function that takes an argument of a forgerie-core:ticket and returns a string that will be appended to the description of created tickets (issues). Useful to create backlinks to the previous system, or addition migration information") (defvar *limit-to-active-users* nil "If non nil, will only add users to the gitlab instance if they are active in the items also coming over for processing. Useful when doing piecemeal conversions.") diff --git a/src/main/gitlab/package.lisp b/src/main/gitlab/package.lisp index c91a9fd..eb6c047 100644 --- a/src/main/gitlab/package.lisp +++ b/src/main/gitlab/package.lisp @@ -1,5 +1,5 @@ (defpackage #:forgerie-gitlab (:use :cl) (:export #:*private-token* #:*server-address* #:*default-project* #:*ssh-public-key* - #:*default-group* #:*single-project* #:*rails-console-ssh-args* #:*merge-request-suffix* - #:*ticket-suffix* #:*limit-to-active-users*)) + #:*default-group* #:*single-project* #:*rails-command* #:*rails-command-args* + #:*merge-request-suffix* #:*ticket-suffix* #:*limit-to-active-users*)) diff --git a/src/main/gitlab/utils.lisp b/src/main/gitlab/utils.lisp index c7d3458..d5acbc0 100644 --- a/src/main/gitlab/utils.lisp +++ b/src/main/gitlab/utils.lisp @@ -1,245 +1,245 @@ (in-package #:forgerie-gitlab) (define-condition http-error nil ((code :initarg :code :reader http-error-code) (path :initarg :path :reader http-error-path) (method :initarg :method :reader http-error-method) (parameters :initarg :parameters :reader http-error-parameters) (resp :initarg :resp :reader http-error-resp)) (:report (lambda (condition stream) (format stream "Http error code: ~A, resp: ~A" (http-error-code condition) (http-error-resp condition))))) (defun convert-js-to-plist (jsown) (cond ((not (listp jsown)) jsown) ((eql :obj (car jsown)) (apply #'append (mapcar (lambda (keyword) (list (intern (string-upcase keyword) :keyword) (convert-js-to-plist (jsown:val jsown keyword)))) (jsown:keywords jsown)))) ((listp jsown) (mapcar #'convert-js-to-plist jsown)) (t (error "Don't know how to handle ~S" jsown)))) (defun make-request (path method parameters &key sudo) (let ((parameters (append (when sudo (list (cons "sudo" sudo))) parameters))) (multiple-value-bind (body code headers uri stream must-close reason-phrase) (drakma:http-request (format nil "~A/api/v4/~A" *server-address* path) :method method :parameters parameters :additional-headers (list (cons "PRIVATE-TOKEN" *private-token*))) (when (not (= 304 code)) ; 304s are empty, and can be ignored (let ((resp (convert-js-to-plist (jsown:parse (map 'string #'code-char body))))) (when forgerie-core:*debug* (format t "*****************~%Gitlab request ~A (~A): ~S~%Status Code: ~S~%Response: ~S~%" path method parameters code resp)) (when (not (<= 200 code 299)) (error (make-instance 'http-error :code code :path path :method method :parameters parameters :resp resp ))) resp))))) (defun git-cmd (project cmd &rest args) (forgerie-core:git-cmd (format nil "~A~A" *working-directory* (getf project :path)) cmd args)) (defun git-cmd-code (project cmd &rest args) (forgerie-core:git-cmd (format nil "~A~A" *working-directory* (getf project :path)) cmd args :error nil)) (defun get-request (path &key parameters sudo) (make-request path :get parameters :sudo sudo)) (defun post-request (path parameters &key sudo) (make-request path :post parameters :sudo sudo)) (defun delete-request (path) (make-request path :delete nil)) (defun put-request (path parameters &key sudo) (make-request path :put parameters :sudo sudo)) (defun merge-request-suffix (mr) (if *merge-request-suffix* (funcall *merge-request-suffix* mr) "")) (defun ticket-suffix (ticket) (if *ticket-suffix* (funcall *ticket-suffix* ticket) "")) (defun to-iso-8601 (d) (multiple-value-bind (sec min hr date month year) (decode-universal-time d 0) (format nil "~A-~2,,,'0@A-~2,,,'0@AT~2,,,'0@A:~2,,,'0@A:~2,,,'0@AZ" year month date hr min sec))) (defstruct mapped-item type original-id id iid project-id) (defstruct mapped-file type original-id response) (defun mapping-file () (format nil "~A/mapping" *working-directory*)) (defvar *mapping* nil) (defun mapping () (or *mapping* (setf *mapping* (when (probe-file (mapping-file)) (with-open-file (str (mapping-file)) (loop :for obj := (read str nil) :while obj :collect obj)))))) (defun find-mapped-item (type original-id) (find (list type original-id) (mapping) :key (lambda (mi) (typecase mi (mapped-item (list (mapped-item-type mi) (mapped-item-original-id mi))) (mapped-file (list (mapped-file-type mi) (mapped-file-original-id mi))))) :test #'equalp)) (defmacro when-unmapped ((type original-id) &rest body) `(when (not (find-mapped-item ,type ,original-id)) ,@body)) (defmacro when-unmapped-with-update ((type original-id) &rest body) `(when-unmapped (,type ,original-id) (update-mapping (,type ,original-id) ,@body))) (defmacro update-mapping ((type original-id) &rest body) (let ((result (gensym)) (str (gensym)) (mapped-item (gensym))) `(let* ((,result ,@body) (,mapped-item (make-mapped-item :type ,type :original-id ,original-id :id (getf ,result :id) :iid (getf ,result :iid) :project-id (getf ,result :project_id)))) (setf *mapping* (cons ,mapped-item (mapping))) (with-open-file (,str (mapping-file) :direction :output :if-exists :append :if-does-not-exist :create) (format ,str "~S" ,mapped-item)) (forgerie-core:check-for-stop) ,result))) (defmacro update-file-mapping ((type original-id) &rest body) (let ((result (gensym)) (str (gensym)) (mapped-item (gensym))) `(let* ((,result ,@body) (,mapped-item (make-mapped-file :type ,type :original-id ,original-id :response ,result))) (setf *mapping* (cons ,mapped-item (mapping))) (with-open-file (,str (mapping-file) :direction :output :if-exists :append :if-does-not-exist :create) (format ,str "~S" ,mapped-item)) (forgerie-core:check-for-stop) ,result))) (defun retrieve-mapping (type original-id) (let ((mi (find-mapped-item type original-id))) (when (not mi) (error "Failed to retrieve mapping for ~S" (list type original-id))) (typecase mi (mapped-item (if (mapped-item-project-id mi) (get-request (format nil "projects/~A/~A/~A" (mapped-item-project-id mi) (case (mapped-item-type mi) (:snippet "snippets") (:merge-request "merge_requests") (:ticket "issues")) (or (mapped-item-iid mi) (mapped-item-id mi)))) (get-request (format nil "~A/~A" (case (mapped-item-type mi) (:user "users")) (or (mapped-item-iid mi) (mapped-item-id mi)))))) (mapped-file (mapped-file-response mi))))) ; This is for development, so that we can export only one project ; and all the tickets/prs associated with it. (defmacro single-project-check (name &rest body) `(when (or (not *single-project*) (string= *single-project* ,name)) ,@body)) (defvar *rails-connection* nil) ; Each command needs to be a one liner standalone (defun rails-command (cmd) (when (not *rails-connection*) (setf *rails-connection* - (sb-ext:run-program "/usr/bin/ssh" *rails-console-ssh-args* + (sb-ext:run-program *rails-command* *rails-command-args* :input :stream :output :stream :wait nil)) (format (sb-ext:process-input *rails-connection*) "0~%" cmd) (force-output (sb-ext:process-input *rails-connection*)) (loop for line = (read-line (sb-ext:process-output *rails-connection*)) do (when forgerie-core:*debug* (format t "Booting: ~A~%" line)) until (string= line "0"))) ; The reason we append a 0 on the end of this, is because irb does some funky ; things, expecting you to be running from a terminal with a tty. So just ; doing a 0 and then checking for that output means we'll A) know when the ; command is done and B) not run into these no tty errors. (format (sb-ext:process-input *rails-connection*) "~A;0~%" cmd) (force-output (sb-ext:process-input *rails-connection*)) (let ((line (read-line (sb-ext:process-output *rails-connection*)))) (loop for line = (read-line (sb-ext:process-output *rails-connection*)) do (when forgerie-core:*debug* (format t "Running: ~A~%" line)) until (string= line "0"))))