Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
gendl
gendl
Commits
a6953fa3
Commit
a6953fa3
authored
Oct 31, 2022
by
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
Changes
1
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
base/rest/source/gdl-app.lisp
View file @
a6953fa3
...
...
@@ -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
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment