Commit a6953fa3 authored by Dave Cooper's avatar Dave Cooper
Browse files

trying for a cleaner build (for app dev)

parent 40a0fa09
Pipeline #7321 passed with stages
in 5 minutes and 44 seconds
......@@ -6,8 +6,84 @@
(defparameter *restart-init-function* nil)
(define-object gdl-app-scripts-mixin ()
:input-slots
((scripts (list (the start-script) (the safe-start-script) (the rc-dot-local)
(the shutdown-script) (the restart-script)))
(start-script
(list :contents (format nil "#!/bin/bash
killall -q -9 ~a
kitchen=`dirname $0`
cd ${kitchen}/..
mkdir -p logs/
./~a -n >> logs/~a.log 2>&1
"
(the application-name)
(the application-name)
(the application-name))
:name (format nil "start~a" (case (getf (the ci-info) :branch)
((:master :main) "")
(:devo "-devo")
(otherwise "-test")))))
(rc-dot-local (list :contents (format nil "#!/bin/sh -e
kitchen=`dirname $0`
script=~a
${kitchen}/${script} &
exit 0
"
(getf (the safe-start-script) :name))
:name "rc.local"))
(safe-start-script (list :contents (format nil "#!/bin/bash
killall -q -9 ~a
kitchen=`dirname $0`
while [ 1 ]
do
${kitchen}/~a
done
"
(getf (the start-script) :name)
(getf (the start-script) :name))
:name (format nil "safe-start~a" (case (getf (the ci-info) :branch)
((:master :main) "")
(:devo "-devo")
(otherwise "-test")))))
(shutdown-script (list :name "shutdown"
:contents (format nil "#!/bin/bash
sudo killall -q -9 ~a
sudo killall -q -9 ~a
sudo killall -q -9 ~a
"
(getf (the safe-start-script) :name)
(getf (the start-script) :name)
(the application-name))))
(restart-script (list :name "restart"
:contents (format nil "#!/bin/bash
killall -q -9 ~a
"
(the application-name))))
))
#-allegro
(define-object gdl-app ()
(define-object gdl-app (gdl-app-scripts-mixin)
:documentation (:description "
This object serves as the driver for the build process for GDL runtime
applications. There is also an undocumented function called
......@@ -43,17 +119,72 @@ give to this object.
\"gdl-test-runtime\"." application-name "gdl-test-runtime")
(application-source-home nil) (static-folders nil)
(static-folder-paths
(and (the application-source-home)
(the static-folders)
(probe-file (the application-source-home))
(mapcar #'(lambda(subdir)
(let ((path (probe-file
(merge-pathnames (format nil "~a/" subdir)
(the application-source-home)))))
(or path (error "~s does not exist.~%" path))))(the static-folders))))
(deploy-target-toplevel "/opt/")
("Lisp Function of zero arguments.
This function will be run in the initiating image before the build is begun."
pre-make-function nil)
(deploy? nil)
(post-make-function
(lambda ()
(when (the deploy?)
;;
;; 2. Copy the new built distribution into place.
;;
(let ((target (merge-pathnames (string-append (the application-name) "/")
(the deploy-target-toplevel))))
(glisp:rsync (the destination-directory) target :options (list "z" "a" "v"))
(dolist (static-folder (the static-folder-paths))
(let* ((name (lastcar (pathname-directory static-folder)))
(target-subdir (merge-pathnames (string-append name "/") target)))
(glisp:rsync static-folder target-subdir
:options (list "z" "a" "d"))
(when (search "patch" (namestring target-subdir))
(uiop:run-program (format nil "chmod 770 ~a" target-subdir)))))
;; Populate kitchen with scripts from in-memory:
(let ((kitchen (ensure-directories-exist (merge-pathnames "kitchen/" target))))
(mapc #'(lambda(script)
(destructuring-bind (&key name contents) script
(with-open-file (out (merge-pathnames name kitchen)
:direction :output
:if-exists :supersede
:if-does-not-exist :create)
(write-string contents out))))
(the scripts))
(uiop:with-current-directory (kitchen) (uiop:run-program "chmod 755 *"))
;;
;; 4. Call the restart script to restart the application in its new version.
;; (Assume we are running build on deploy host as same user)
(multiple-value-bind (output error code)
(uiop:with-current-directory (kitchen)
(uiop:run-program (format nil "./~a" (getf (the restart-script) :name))
:output :string :error-output :string
:ignore-error-status t))
(case code
(0 (format t "Successful kill for ~a, output is: ~%~%*****~%~%~a~%"
(the application-name) output))
(otherwise
(error "Unsuccessful kill for ~a, Code: ~a, output/error: ~%~a~%~%ERROR:~%~%~a~%
Running the ~a script in case process was dead. Please restart/troubleshoot manually as necessary."
(the application-name) code output error
(the application-name))))))))))
("Lisp Function of zero arguments.
This function will be run in the initiating image after the build is finished."
post-make-function nil)
("Lisp expression. This form will be evaluated in the image being
built, before the loading of application-fasls begins, but
......@@ -131,10 +262,14 @@ This function will be run in the initiating image after the build is finished."
:computed-slots
((ci-info (let ((branch (uiop:getenv "CI_COMMIT_BRANCH"))
(sha (uiop:getenv "CI_COMMIT_SHA")))
(list :branch (make-keyword branch)
:sha (make-keyword sha))))
(list :branch (and branch (make-keyword branch))
:sha (and sha (make-keyword sha)))))
(swank-port (case (getf (the ci-info) :branch)
((:master :main) 1088)
(:devo 10088)
(otherwise 10098)))
(destination-exe (merge-pathnames (format nil "~a~a"
(the application-name)
#+windows ".exe" #-windows "")
......@@ -163,7 +298,10 @@ This function will be run in the initiating image after the build is finished."
,(when (the restart-init-function)
`(setf (symbol-function '*restart-init-function*) ,(the restart-init-function)))
;;
;; FLAG -- if destination-directory already exists, and no
;; validation specified, error with continuation to delete.
;;
(ccl:save-application (progn (ensure-directories-exist ,(the destination-exe))
,(the destination-exe))
:prepend-kernel t
......@@ -185,76 +323,7 @@ This function will be run in the initiating image after the build is finished."
(gendl::initialize :startup-banner? t)
,(when (the restart-init-function)
`(funcall #',(the restart-init-function)))
(funcall #',(the restart-app-function)))))
#+nil
(toplevel-function
`(lambda ()
,@(remove
nil
`((uiop:setup-temporary-directory)
;;
;; FLAG -- sort out initialization so we don't have to do it
;; surgically/internally like this.
;;
(gendl::initialize)
(setq glisp:*gdl-home* glisp:*gdl-program-home*)
;;
;; FLAG -- supposed to come from gwl:initialize but need to customize for now
;;
(glisp:initialize-multiprocessing)
(when (and (find-package :zacl) (find-package :net.aserve))
(setf (symbol-value (read-from-string "excl:*initial-terminal-io*"))
*terminal-io*)
(setf (symbol-value (read-from-string "net.aserve:*wserver*"))
(make-instance (read-from-string "net.aserve:wserver"))))
(setq *iid-random-state* (make-random-state t))
(glisp:set-settings (symbol-value (read-from-string "gwl::*settings*")))
;;
;; end of stuff from gwl:initialize
;;
;;
;; FLAG -- make all this boilerplate into a funciton
;;
,(when (member (the build-level)
(list :runtime :pro :geom-base :gwl-graphics))
`(setf (symbol-value (read-from-string "pdf::*cl-pdf-base-directory*"))
glisp:*gdl-program-home*))
,(when (member (the build-level)
(list :runtime :pro :geom-base :gwl-graphics))
`(setf (symbol-value (read-from-string "pdf::*afm-files-directories*"))
(list (merge-pathnames "afm/"
(symbol-value
(read-from-string "pdf::*cl-pdf-base-directory*"))))))
,(when (member (the build-level)
(list :runtime :pro :geom-base :gwl-graphics))
`(setf (symbol-value (read-from-string
"cl-typesetting-hyphen::*cl-typesetting-base-directory*"))
glisp:*gdl-program-home*))
,(when (member (the build-level)
(list :runtime :pro :geom-base :gwl-graphics))
`(setf (symbol-value (read-from-string
"cl-typesetting-hyphen::*hyphen-patterns-directory*"))
(merge-pathnames
"hyphen-patterns/"
(symbol-value (read-from-string
"cl-typesetting-hyphen::*cl-typesetting-base-directory*")))))
,(when (member (the build-level)
(list :runtime :pro :geom-base :gwl-graphics))
`(funcall (read-from-string "cl-typesetting::initialize!")
:afm-files-directories
(symbol-value (read-from-string "pdf::*afm-files-directories*"))
:hyphen-patterns-directory
(symbol-value (read-from-string
"cl-typesetting-hyphen::*hyphen-patterns-directory*"))))
,(when (the restart-init-function) `(funcall #',(the restart-init-function)))
(gdl::load-gdl-init-files))))))
(funcall #',(the restart-app-function))))))
:functions
((copy-with-warning
......@@ -298,6 +367,7 @@ This function will be run in the initiating image after the build is finished."
(merge-pathnames "hyphen-patterns/"
(glisp:system-home :cl-typesetting)))))
(merge-pathnames "hyphen-patterns/" (the destination-directory))))))
("Void. Does the application build and creates or replaces
......
Supports Markdown
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