steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

More preparations for a release

db4
Slava Pestov 2010-02-15 01:03:15 +13:00
parent a1037f9657
commit a1cb7b4be1
13 changed files with 175 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
basis/bootstrap/image/download/download.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2008 Slava Pestov.
! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: http.client checksums checksums.md5 splitting assocs
kernel io.files bootstrap.image sequences io urls ;
@ -19,9 +19,11 @@ CONSTANT: url URL" http://factorcode.org/images/latest/"
] [ drop t ] if ;
: download-image ( arch -- )
boot-image-name dup need-new-image? [
"Downloading " write dup write "..." print
url over >url derive-url download
url swap boot-image-name >url derive-url download ;
: maybe-download-image ( arch -- )
dup boot-image-name need-new-image? [
dup download-image
need-new-image? [
"Boot image corrupt, or checksums.txt on server out of date" throw
] when
@ -30,6 +32,6 @@ CONSTANT: url URL" http://factorcode.org/images/latest/"
drop
] if ;
: download-my-image ( -- ) my-arch download-image ;
: download-my-image ( -- ) my-arch maybe-download-image ;
MAIN: download-my-image

29
extra/mason/server/release/release.factor
View File

@ -2,20 +2,12 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors calendar db db.tuples db.types grouping io
io.encodings.ascii io.launcher kernel locals make
mason.release.archive mason.server namespaces sequences ;
mason.release.archive mason.config mason.platform mason.server
namespaces sequences ;
IN: mason.server.release
! Host to upload binary package to.
SYMBOL: upload-host
! Username to log in.
SYMBOL: upload-username
! Directory with binary packages.
SYMBOL: upload-directory
: platform ( builder -- string )
[ os>> ] [ cpu>> ] bi "-" glue ;
[ os>> ] [ cpu>> ] bi (platform) ;
: package-name ( builder -- string )
[ platform ] [ last-release>> ] bi "/" glue ;
@ -23,17 +15,17 @@ SYMBOL: upload-directory
: release-name ( version builder -- string )
[
"releases/" %
[ platform % "/" % ]
over % "/" %
[ "factor-" % platform % "-" % % ]
[ os>> extension % ]
tri
bi
] "" make ;
: release-command ( version builder -- command )
[
"ln -s " %
"cp " %
[ nip package-name % " " % ] [ release-name % ] 2bi
] { } make ;
] "" make ;
TUPLE: release
host-name os cpu
@ -59,12 +51,13 @@ release "RELEASES" {
[ "ssh" , upload-host get , "-l" , upload-username get , ] { } make
<process>
swap >>command
30 seconds >>timeout
5 minutes >>timeout
ascii [ write ] with-process-writer ;
: release-script ( version builders -- string )
upload-directory get "cd " "\n" surround prepend
[ release-command ] with map "\n" join ;
[ upload-directory get "cd " "\n" surround ] 2dip
[ release-command ] with map "\n" join
append ;
: create-releases ( version builders -- )
release-script execute-on-server ;

1
extra/mason/source/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

43
extra/mason/source/source.factor Normal file
View File

@ -0,0 +1,43 @@
! Copyright (C) 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: bootstrap.image bootstrap.image.download io io.directories
io.directories.hierarchy io.files.unique io.launcher
io.pathnames kernel sequences namespaces mason.common mason.config ;
IN: mason.source
: clone-factor ( -- )
{ "git" "clone" } home "factor" append-path suffix try-process ;
: prepare-source ( -- )
"factor" [
".git" delete-tree
images [ download-image ] each
] with-directory ;
: package-name ( version -- string )
"factor-src-" ".zip" surround ;
: make-tarball ( version -- path )
[ { "zip" "-qr9" } ] dip package-name
[ suffix "factor" suffix try-process ] keep ;
: make-package ( version -- path )
unique-directory
[
clone-factor prepare-source make-tarball
"Package created: " write absolute-path dup print
] with-directory ;
: remote-location ( version -- dest )
[ upload-directory get "/releases/" ] dip 3append ;
: remote-archive-name ( version -- dest )
[ remote-location ] [ package-name ] bi "/" glue ;
: upload-package ( package version -- )
[ upload-username get upload-host get ] dip
remote-archive-name
upload-safely ;
: release-source-package ( version -- )
[ make-package ] [ upload-package ] bi ;

14
extra/webapps/mason/grids/grids.factor
View File

@ -67,7 +67,12 @@ CONSTANT: cpus
: <package-grid-action> ( -- action )
<action>
[ package-grid xml>string "text/html" <content> ] >>display ;
[
[
package-grid xml>string
"text/html" <content>
] with-mason-db
] >>display ;
: release-url ( builder -- url )
[ URL" $mason-app/release" ] dip
@ -90,4 +95,9 @@ CONSTANT: cpus
: <release-grid-action> ( -- action )
<action>
[ release-grid xml>string "text/html" <content> ] >>display ;
[
[
release-grid xml>string
"text/html" <content>
] with-mason-db
] >>display ;

20
extra/webapps/mason/make-release.xml Normal file
View File

@ -0,0 +1,20 @@
<?xml version='1.0' ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>Make release</title>
</head>
<body>
<t:form t:action="$mason-app/make-release">
Version: <t:field t:name="version" />
<button type="submit">Go</button>
</t:form>
</body>
</html>
</t:chloe>

1
extra/webapps/mason/make-release/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

16
extra/webapps/mason/make-release/make-release.factor Normal file
View File

@ -0,0 +1,16 @@
! Copyright (C) 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors furnace.actions html.forms
http.server.responses mason.server mason.server.release
validators ;
IN: webapps.mason.make-release
: <make-release-action> ( -- action )
<page-action>
[ { { "version" [ v-one-line ] } } validate-params ] >>validate
[
[
"version" value do-release
"OK" "text/html" <content>
] with-mason-db
] >>submit ;

31
extra/webapps/mason/mason.factor
View File

@ -1,24 +1,41 @@
! Copyright (C) 2009, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors furnace.db http.server.dispatchers mason.server
webapps.mason.grids webapps.mason.package webapps.mason.release
webapps.mason.report ;
USING: accessors furnace.auth furnace.db
http.server.dispatchers mason.server webapps.mason.grids
webapps.mason.make-release webapps.mason.package
webapps.mason.release webapps.mason.report ;
IN: webapps.mason
TUPLE: mason-app < dispatcher ;
SYMBOL: can-make-releases?
can-make-releases? define-capability
: <mason-app> ( -- dispatcher )
mason-app new-dispatcher
<build-report-action> "report" add-responder
<build-report-action>
"report" add-responder
<download-package-action>
{ mason-app "download-package" } >>template
"package" add-responder
<package-grid-action> "packages" add-responder
<package-grid-action>
"packages" add-responder
<download-release-action>
{ mason-app "download-release" } >>template
"release" add-responder
<release-grid-action> "releases" add-responder
mason-db <db-persistence> ;
<release-grid-action>
"releases" add-responder
<make-release-action>
{ mason-app "make-release" } >>template
<protected>
"make releases" >>description
{ can-make-releases? } >>capabilities
"make-release" add-responder ;

30
extra/webapps/mason/package/package.factor
View File

@ -54,18 +54,20 @@ IN: webapps.mason.package
: <download-package-action> ( -- action )
<page-action>
[
validate-os/cpu
"os" value "cpu" value (platform) "platform" set-value
current-builder {
[ package-link "package" set-value ]
[ release-git-id>> git-link "git-id" set-value ]
[ requirements "requirements" set-value ]
[ host-name>> "host-name" set-value ]
[ current-status "status" set-value ]
[ last-build-status "last-build" set-value ]
[ clean-build-status "last-clean-build" set-value ]
[ packages-link "binaries" set-value ]
[ clean-image-link "clean-images" set-value ]
[ report-link "last-report" set-value ]
} cleave
[
validate-os/cpu
"os" value "cpu" value (platform) "platform" set-value
current-builder {
[ package-link "package" set-value ]
[ release-git-id>> git-link "git-id" set-value ]
[ requirements "requirements" set-value ]
[ host-name>> "host-name" set-value ]
[ current-status "status" set-value ]
[ last-build-status "last-build" set-value ]
[ clean-build-status "last-clean-build" set-value ]
[ packages-link "binaries" set-value ]
[ clean-image-link "clean-images" set-value ]
[ report-link "last-report" set-value ]
} cleave
] with-mason-db
] >>init ;

27
extra/webapps/mason/release/release.factor
View File

@ -1,25 +1,24 @@
! Copyright (C) 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors furnace.actions html.forms kernel
mason.platform mason.report sequences webapps.mason
webapps.mason.utils ;
mason.platform mason.report mason.server sequences webapps.mason
webapps.mason.utils io.pathnames ;
IN: webapps.mason.release
: releases-url ( builder -- url )
[ os>> ] [ cpu>> ] bi (platform)
"http://downloads.factorcode.org/releases/" prepend ;
: release-link ( builder -- xml )
[ releases-url ] [ last-release>> ] bi [ "/" glue ] keep link ;
[ "http://downloads.factorcode.org/" ] dip
last-release>> [ "/" glue ] [ file-name ] bi link ;
: <download-release-action> ( -- action )
<page-action>
[
validate-os/cpu
"os" value "cpu" value (platform) "platform" set-value
current-release
[ release-link "release" set-value ]
[ release-git-id>> git-link "git-id" set-value ]
[ requirements "requirements" set-value ]
tri
[
validate-os/cpu
"os" value "cpu" value (platform) "platform" set-value
current-release
[ release-link "release" set-value ]
[ release-git-id>> git-link "git-id" set-value ]
[ requirements "requirements" set-value ]
tri
] with-mason-db
] >>init ;

11
extra/webapps/mason/report/report.factor
View File

@ -1,13 +1,18 @@
! Copyright (C) 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors furnace.actions http.server.responses kernel
urls webapps.mason.utils xml.syntax ;
urls mason.server webapps.mason.utils xml.syntax ;
IN: webapps.mason.report
: <build-report-action> ( -- action )
<action>
[ validate-os/cpu ] >>init
[ current-builder last-report>> "text/html" <content> ] >>display ;
[ validate-os/cpu ] >>init
[
[
current-builder last-report>>
"text/html" <content>
] with-mason-db
] >>display ;
: report-link ( builder -- xml )
[ URL" report" ] dip

5
extra/websites/concatenative/concatenative.factor
View File

@ -1,4 +1,4 @@
! Copyright (c) 2008 Slava Pestov
! Copyright (c) 2008, 2010 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel sequences assocs io.files io.pathnames
io.sockets io.sockets.secure io.servers.connection
@ -79,6 +79,7 @@ SYMBOL: dh-file
<user-admin> <login-config> <factor-boilerplate> "user-admin" add-responder
<pastebin> <login-config> <factor-boilerplate> "pastebin" add-responder
<planet> <login-config> <factor-boilerplate> "planet" add-responder
<mason-app> <login-config> "mason" add-responder
"/tmp/docs/" <help-webapp> "docs" add-responder
test-db <alloy>
main-responder set-global ;
@ -97,9 +98,9 @@ SYMBOL: dh-file
<login-config> <factor-boilerplate> test-db <alloy> "concatenative.org" add-responder
<pastebin> <login-config> <factor-boilerplate> test-db <alloy> "paste.factorcode.org" add-responder
<planet> <login-config> <factor-boilerplate> test-db <alloy> "planet.factorcode.org" add-responder
<mason-app> <login-config> "builds.factorcode.org" add-responder
home "docs" append-path <help-webapp> "docs.factorcode.org" add-responder
home "cgi" append-path <gitweb> "gitweb.factorcode.org" add-responder
<mason-app> "builds.factorcode.org" add-responder
main-responder set-global ;
: <factor-secure-config> ( -- config )