factor/basis/tools/deploy/backend/backend.factor

127 lines
4.1 KiB
Factor
Raw Normal View History

2010-02-17 09:57:10 -05:00
! Copyright (C) 2007, 2010 Slava Pestov.
2008-01-05 19:37:13 -05:00
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs bootstrap.image hashtables io io.directories
io.encodings.utf8 io.files io.files.temp io.launcher io.pathnames
kernel locals make namespaces prettyprint sequences splitting system
tools.deploy.config tools.deploy.config.editor tools.deploy.embed
tools.deploy.libraries vocabs.loader vocabs.metadata.resources ;
2008-01-05 19:37:13 -05:00
IN: tools.deploy.backend
2008-05-10 16:22:38 -04:00
: copy-vm ( executable bundle-name -- vm-path )
prepend-path vm-path over copy-file ;
2008-05-10 16:22:38 -04:00
TUPLE: vocab-manifest vocabs libraries ;
: copy-resources ( manifest name dir -- )
append-path swap vocabs>> [ copy-vocab-resources ] with each ;
2010-02-17 09:57:10 -05:00
ERROR: can't-deploy-library-file library ;
: copy-library ( dir library -- )
dup find-library-file
2010-02-17 09:57:10 -05:00
[ swap over file-name append-path copy-file ]
[ can't-deploy-library-file ] ?if ;
: copy-libraries ( manifest name dir -- )
append-path swap libraries>> [ copy-library ] with each ;
2008-05-10 16:22:38 -04:00
: deployed-image-name ( vocab -- str )
".image" append temp-file ;
2008-01-05 19:37:13 -05:00
2008-09-18 19:20:26 -04:00
: copy-lines ( -- )
readln [ print flush copy-lines ] when* ;
2008-02-03 21:36:04 -05:00
: run-with-output ( arguments -- )
2008-03-06 21:44:52 -05:00
<process>
swap >>command
+stdout+ >>stderr
+closed+ >>stdin
2008-03-26 16:59:11 -04:00
+low-priority+ >>priority
2008-09-18 19:20:26 -04:00
utf8 [ copy-lines ] with-process-reader ;
: make-boot-image ( -- )
2015-09-08 19:15:10 -04:00
! If stage1 image doesn't exist, create one.
my-boot-image-name resource-path exists?
[ make-my-image ] unless ;
2008-01-05 19:37:13 -05:00
2008-03-20 22:11:53 -04:00
: staging-image-name ( profile -- name )
"-" join "." my-arch-name 3append
"staging." ".image" surround cache-file ;
2008-01-05 19:37:13 -05:00
: delete-staging-images ( -- )
cache-directory [
[ "staging." head? ] filter
"." my-arch-name ".image" 3append [ tail? ] curry filter
[ delete-file ] each
] with-directory-files ;
: input-image-name ( profile -- name )
but-last [ my-boot-image-name ] [ staging-image-name ] if-empty ;
: run-factor ( vm-path flags -- )
swap prefix dup . run-with-output ; inline
2008-03-20 22:11:53 -04:00
: staging-command-line ( profile -- flags )
2008-01-05 19:37:13 -05:00
[
[
"-staging" , "-no-user-init" , "-pic=0" ,
[ staging-image-name "-output-image=" prepend , ]
[ " " join "-include=" prepend , ] bi
2008-03-20 22:11:53 -04:00
] [
input-image-name "-i=" prepend ,
"-resource-path=" "" resource-path append ,
"-run=tools.deploy.restage" ,
] bi
2008-03-20 22:11:53 -04:00
] { } make ;
2008-01-05 19:37:13 -05:00
2008-03-20 22:11:53 -04:00
: make-staging-image ( profile -- )
{ } [ suffix ] accumulate* [ staging-image-name exists? ] reject
[ staging-command-line ] map
[ vm-path swap run-factor ] each ;
2008-12-08 15:58:00 -05:00
: make-deploy-config ( vocab -- file )
[ deploy-config vocab-roots get vocab-roots associate assoc-union unparse-use ]
2008-12-08 17:02:31 -05:00
[ "deploy-config-" prepend temp-file ] bi
2008-12-08 15:58:00 -05:00
[ utf8 set-file-contents ] keep ;
: deploy-command-line ( image vocab manifest-file profile -- flags )
2008-01-05 19:37:13 -05:00
[
"-pic=0" ,
staging-image-name "-i=" prepend ,
"-vocab-manifest-out=" prepend ,
[ "-deploy-vocab=" prepend , ]
[ make-deploy-config "-deploy-config=" prepend , ] bi
"-output-image=" prepend ,
"-resource-path=" "" resource-path append ,
"-run=tools.deploy.shaker" ,
] { } make ;
2008-01-05 19:37:13 -05:00
: parse-vocab-manifest-file ( path -- vocab-manifest )
utf8 file-lines [ "empty vocab manifest!" throw ] [
unclip-slice "VOCABS:" =
[ { "LIBRARIES:" } split1 vocab-manifest boa ]
[ "invalid vocab manifest!" throw ] if
] if-empty ;
2015-07-20 10:54:26 -04:00
:: make-deploy-image ( vm image vocab config -- manifest )
2008-02-04 21:49:59 -05:00
make-boot-image
config config>profile :> profile
vocab "vocab-manifest-" prepend temp-file :> manifest-file
image vocab manifest-file profile deploy-command-line :> flags
profile make-staging-image
vm flags run-factor
manifest-file parse-vocab-manifest-file ;
2008-01-05 19:37:13 -05:00
:: make-deploy-image-executable ( vm image vocab config -- manifest )
vm image vocab config make-deploy-image
image vm embed-image ;
SYMBOL: open-directory-after-deploy?
t open-directory-after-deploy? set-global
2008-04-02 20:46:37 -04:00
HOOK: deploy* os ( vocab -- )
HOOK: deploy-path os ( vocab -- path )