ci: Start new vocabs.
Add ci.docker for running commands in docker. Add ci.run-process for running commands and capturing everything from their run. USE: ci.docker USE: ci.run-process { "run" "hello-world" } "docker" find-in-standard-login-path prefix ci-run-process>autopsy autopsy.handle-patch-and-put
parent
12918ae2a5
commit
0655ed4e00
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
|
@ -0,0 +1,78 @@
|
|||
! Copyright (C) 2018 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io.files.links io.launcher io.standard-paths json.reader
|
||||
kernel literals namespaces sequences strings system ;
|
||||
IN: ci.docker
|
||||
|
||||
SYMBOL: docker-username
|
||||
SYMBOL: docker-password
|
||||
|
||||
: docker-path ( -- path )
|
||||
"docker" find-in-standard-login-path ;
|
||||
|
||||
: docker-machine-path ( -- path )
|
||||
"docker-machine" find-in-standard-login-path ;
|
||||
|
||||
: vboxmanage-path ( -- path )
|
||||
"VBoxManage" find-in-standard-login-path ;
|
||||
|
||||
: sudo-linux ( seq -- seq' )
|
||||
os linux? [ "sudo" prefix ] when ;
|
||||
|
||||
: docker-lines ( seq -- lines )
|
||||
docker-path prefix sudo-linux process-lines ;
|
||||
|
||||
: docker-machine-lines ( seq -- lines )
|
||||
docker-machine-path prefix process-lines ;
|
||||
|
||||
|
||||
: docker-command ( seq -- )
|
||||
docker-path prefix sudo-linux try-output-process ;
|
||||
|
||||
: docker-machine-command ( seq -- )
|
||||
docker-machine-path prefix try-output-process ;
|
||||
|
||||
|
||||
: docker-version ( -- string )
|
||||
{ "version" } docker-lines ;
|
||||
|
||||
: docker-machine-version ( -- string )
|
||||
{ "version" } docker-machine-lines ?first ;
|
||||
|
||||
|
||||
|
||||
: docker-machine-inspect ( string -- json )
|
||||
{ "inspect" } swap suffix docker-machine-lines "" join json> ;
|
||||
|
||||
|
||||
: docker-machines ( -- seq )
|
||||
{ "ls" "-q" } docker-machine-lines ;
|
||||
|
||||
: docker-machine-status ( string -- status )
|
||||
{ "status" } swap suffix docker-machine-lines ;
|
||||
|
||||
|
||||
: docker-image-names ( -- seq )
|
||||
{ "image" "ls" "-q" } docker-lines ;
|
||||
|
||||
: docker-image-ls ( -- seq )
|
||||
{ "image" "ls" } docker-lines ;
|
||||
|
||||
: docker-login ( -- )
|
||||
${
|
||||
"sudo"
|
||||
docker-path "login"
|
||||
"-p" docker-password get-global
|
||||
"-u" docker-username get-global
|
||||
} run-process drop ;
|
||||
|
||||
GENERIC: docker-pull ( obj -- )
|
||||
|
||||
M: string docker-pull ( string -- )
|
||||
{ "pull" } swap suffix docker-command ;
|
||||
|
||||
M: sequence docker-pull ( seq -- )
|
||||
[ docker-pull ] each ;
|
||||
|
||||
: docker-hello-world ( -- )
|
||||
{ "run" "hello-world" } docker-command ;
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
|
@ -0,0 +1,74 @@
|
|||
! Copyright (C) 2018 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs calendar combinators environment
|
||||
escape-strings fry io io.pathnames io.streams.string kernel math
|
||||
math.parser namespaces prettyprint prettyprint.config sequences
|
||||
tools.deploy.backend tools.time unix.groups unix.users uuid ;
|
||||
IN: ci.run-process
|
||||
|
||||
TUPLE: process-autopsy
|
||||
timestamp os-envs
|
||||
cwd uid euid gid egid out elapsed os-envs-after process ;
|
||||
|
||||
: ci-run-process ( process -- timestamp os-envs cwd uid euid gid egid out elapsed os-envs' process )
|
||||
[
|
||||
[
|
||||
gmt os-envs current-directory get
|
||||
real-user-id effective-user-id
|
||||
real-group-id effective-group-id
|
||||
] dip [
|
||||
'[ _ run-with-output ] with-string-writer
|
||||
] benchmark os-envs
|
||||
] keep ;
|
||||
|
||||
: ci-run-process>autopsy ( process -- autopsy )
|
||||
ci-run-process process-autopsy boa ;
|
||||
|
||||
: unparse-full ( obj -- str )
|
||||
[ unparse ] without-limits ;
|
||||
|
||||
: autopsy. ( autopsy -- )
|
||||
{
|
||||
[ drop "<AUTOPSY: " uuid4 append print nl ]
|
||||
[
|
||||
bl bl timestamp>> timestamp>unix-time >float number>string
|
||||
"unix-time" tag-payload print nl
|
||||
]
|
||||
[
|
||||
bl bl elapsed>> number>string "elapsed-nanos" tag-payload print nl
|
||||
]
|
||||
[
|
||||
bl bl cwd>> "cwd" tag-payload print nl
|
||||
]
|
||||
[
|
||||
bl bl uid>> number>string "uid" tag-payload print nl
|
||||
]
|
||||
[
|
||||
bl bl euid>> number>string "euid" tag-payload print nl
|
||||
]
|
||||
[
|
||||
bl bl gid>> number>string "gid" tag-payload print nl
|
||||
]
|
||||
[
|
||||
bl bl egid>> number>string "egid" tag-payload print nl
|
||||
]
|
||||
[
|
||||
bl bl os-envs>> unparse-full "os-envs" tag-payload print nl
|
||||
]
|
||||
[
|
||||
bl bl os-envs>> unparse-full "os-envs-after" tag-payload print nl
|
||||
]
|
||||
[
|
||||
bl bl [ os-envs-after>> ] [ os-envs>> ] bi assoc-diff unparse-full "os-envs-diff" tag-payload print nl
|
||||
]
|
||||
[
|
||||
bl bl [ os-envs>> ] [ os-envs-after>> ] bi assoc-diff unparse-full "os-envs-swap-diff" tag-payload print nl
|
||||
]
|
||||
[
|
||||
bl bl process>> unparse-full "process" tag-payload print nl
|
||||
]
|
||||
[
|
||||
bl bl out>> "out" tag-payload print nl
|
||||
]
|
||||
[ drop ";AUTOPSY>" print ]
|
||||
} cleave ;
|
Loading…
Reference in New Issue