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. ! See http://factorcode.org/license.txt for BSD license.
USING: http.client checksums checksums.md5 splitting assocs USING: http.client checksums checksums.md5 splitting assocs
kernel io.files bootstrap.image sequences io urls ; kernel io.files bootstrap.image sequences io urls ;
@ -19,9 +19,11 @@ CONSTANT: url URL" http://factorcode.org/images/latest/"
] [ drop t ] if ; ] [ drop t ] if ;
: download-image ( arch -- ) : download-image ( arch -- )
boot-image-name dup need-new-image? [ url swap boot-image-name >url derive-url download ;
"Downloading " write dup write "..." print
url over >url derive-url download : maybe-download-image ( arch -- )
dup boot-image-name need-new-image? [
dup download-image
need-new-image? [ need-new-image? [
"Boot image corrupt, or checksums.txt on server out of date" throw "Boot image corrupt, or checksums.txt on server out of date" throw
] when ] when
@ -30,6 +32,6 @@ CONSTANT: url URL" http://factorcode.org/images/latest/"
drop drop
] if ; ] if ;
: download-my-image ( -- ) my-arch download-image ; : download-my-image ( -- ) my-arch maybe-download-image ;
MAIN: download-my-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. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors calendar db db.tuples db.types grouping io USING: accessors calendar db db.tuples db.types grouping io
io.encodings.ascii io.launcher kernel locals make 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 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 ) : platform ( builder -- string )
[ os>> ] [ cpu>> ] bi "-" glue ; [ os>> ] [ cpu>> ] bi (platform) ;
: package-name ( builder -- string ) : package-name ( builder -- string )
[ platform ] [ last-release>> ] bi "/" glue ; [ platform ] [ last-release>> ] bi "/" glue ;
@ -23,17 +15,17 @@ SYMBOL: upload-directory
: release-name ( version builder -- string ) : release-name ( version builder -- string )
[ [
"releases/" % "releases/" %
[ platform % "/" % ] over % "/" %
[ "factor-" % platform % "-" % % ] [ "factor-" % platform % "-" % % ]
[ os>> extension % ] [ os>> extension % ]
tri bi
] "" make ; ] "" make ;
: release-command ( version builder -- command ) : release-command ( version builder -- command )
[ [
"ln -s " % "cp " %
[ nip package-name % " " % ] [ release-name % ] 2bi [ nip package-name % " " % ] [ release-name % ] 2bi
] { } make ; ] "" make ;
TUPLE: release TUPLE: release
host-name os cpu host-name os cpu
@ -59,12 +51,13 @@ release "RELEASES" {
[ "ssh" , upload-host get , "-l" , upload-username get , ] { } make [ "ssh" , upload-host get , "-l" , upload-username get , ] { } make
<process> <process>
swap >>command swap >>command
30 seconds >>timeout 5 minutes >>timeout
ascii [ write ] with-process-writer ; ascii [ write ] with-process-writer ;
: release-script ( version builders -- string ) : release-script ( version builders -- string )
upload-directory get "cd " "\n" surround prepend [ upload-directory get "cd " "\n" surround ] 2dip
[ release-command ] with map "\n" join ; [ release-command ] with map "\n" join
append ;
: create-releases ( version builders -- ) : create-releases ( version builders -- )
release-script execute-on-server ; 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 ) : <package-grid-action> ( -- 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 ) : release-url ( builder -- url )
[ URL" $mason-app/release" ] dip [ URL" $mason-app/release" ] dip
@ -90,4 +95,9 @@ CONSTANT: cpus
: <release-grid-action> ( -- action ) : <release-grid-action> ( -- 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. ! Copyright (C) 2009, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors furnace.db http.server.dispatchers mason.server USING: accessors furnace.auth furnace.db
webapps.mason.grids webapps.mason.package webapps.mason.release http.server.dispatchers mason.server webapps.mason.grids
webapps.mason.report ; webapps.mason.make-release webapps.mason.package
webapps.mason.release webapps.mason.report ;
IN: webapps.mason IN: webapps.mason
TUPLE: mason-app < dispatcher ; TUPLE: mason-app < dispatcher ;
SYMBOL: can-make-releases?
can-make-releases? define-capability
: <mason-app> ( -- dispatcher ) : <mason-app> ( -- dispatcher )
mason-app new-dispatcher mason-app new-dispatcher
<build-report-action> "report" add-responder <build-report-action>
"report" add-responder
<download-package-action> <download-package-action>
{ mason-app "download-package" } >>template { mason-app "download-package" } >>template
"package" add-responder "package" add-responder
<package-grid-action> "packages" add-responder <package-grid-action>
"packages" add-responder
<download-release-action> <download-release-action>
{ mason-app "download-release" } >>template { mason-app "download-release" } >>template
"release" add-responder "release" add-responder
<release-grid-action> "releases" add-responder <release-grid-action>
mason-db <db-persistence> ; "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 ) : <download-package-action> ( -- action )
<page-action> <page-action>
[ [
validate-os/cpu [
"os" value "cpu" value (platform) "platform" set-value validate-os/cpu
current-builder { "os" value "cpu" value (platform) "platform" set-value
[ package-link "package" set-value ] current-builder {
[ release-git-id>> git-link "git-id" set-value ] [ package-link "package" set-value ]
[ requirements "requirements" set-value ] [ release-git-id>> git-link "git-id" set-value ]
[ host-name>> "host-name" set-value ] [ requirements "requirements" set-value ]
[ current-status "status" set-value ] [ host-name>> "host-name" set-value ]
[ last-build-status "last-build" set-value ] [ current-status "status" set-value ]
[ clean-build-status "last-clean-build" set-value ] [ last-build-status "last-build" set-value ]
[ packages-link "binaries" set-value ] [ clean-build-status "last-clean-build" set-value ]
[ clean-image-link "clean-images" set-value ] [ packages-link "binaries" set-value ]
[ report-link "last-report" set-value ] [ clean-image-link "clean-images" set-value ]
} cleave [ report-link "last-report" set-value ]
} cleave
] with-mason-db
] >>init ; ] >>init ;

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

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

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

@ -1,13 +1,18 @@
! Copyright (C) 2010 Slava Pestov. ! Copyright (C) 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors furnace.actions http.server.responses kernel 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 IN: webapps.mason.report
: <build-report-action> ( -- action ) : <build-report-action> ( -- action )
<action> <action>
[ validate-os/cpu ] >>init [ validate-os/cpu ] >>init
[ current-builder last-report>> "text/html" <content> ] >>display ; [
[
current-builder last-report>>
"text/html" <content>
] with-mason-db
] >>display ;
: report-link ( builder -- xml ) : report-link ( builder -- xml )
[ URL" report" ] dip [ 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. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel sequences assocs io.files io.pathnames USING: accessors kernel sequences assocs io.files io.pathnames
io.sockets io.sockets.secure io.servers.connection 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 <user-admin> <login-config> <factor-boilerplate> "user-admin" add-responder
<pastebin> <login-config> <factor-boilerplate> "pastebin" add-responder <pastebin> <login-config> <factor-boilerplate> "pastebin" add-responder
<planet> <login-config> <factor-boilerplate> "planet" add-responder <planet> <login-config> <factor-boilerplate> "planet" add-responder
<mason-app> <login-config> "mason" add-responder
"/tmp/docs/" <help-webapp> "docs" add-responder "/tmp/docs/" <help-webapp> "docs" add-responder
test-db <alloy> test-db <alloy>
main-responder set-global ; main-responder set-global ;
@ -97,9 +98,9 @@ SYMBOL: dh-file
<login-config> <factor-boilerplate> test-db <alloy> "concatenative.org" add-responder <login-config> <factor-boilerplate> test-db <alloy> "concatenative.org" add-responder
<pastebin> <login-config> <factor-boilerplate> test-db <alloy> "paste.factorcode.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 <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 "docs" append-path <help-webapp> "docs.factorcode.org" add-responder
home "cgi" append-path <gitweb> "gitweb.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 ; main-responder set-global ;
: <factor-secure-config> ( -- config ) : <factor-secure-config> ( -- config )