From a1cb7b4be1b05facb5baee2c3fadbe46fbd866d2 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 15 Feb 2010 01:03:15 +1300 Subject: [PATCH] More preparations for a release --- .../bootstrap/image/download/download.factor | 12 +++--- extra/mason/server/release/release.factor | 29 +++++-------- extra/mason/source/authors.txt | 1 + extra/mason/source/source.factor | 43 +++++++++++++++++++ extra/webapps/mason/grids/grids.factor | 14 +++++- extra/webapps/mason/make-release.xml | 20 +++++++++ extra/webapps/mason/make-release/authors.txt | 1 + .../mason/make-release/make-release.factor | 16 +++++++ extra/webapps/mason/mason.factor | 31 ++++++++++--- extra/webapps/mason/package/package.factor | 30 +++++++------ extra/webapps/mason/release/release.factor | 27 ++++++------ extra/webapps/mason/report/report.factor | 11 +++-- .../concatenative/concatenative.factor | 5 ++- 13 files changed, 175 insertions(+), 65 deletions(-) create mode 100644 extra/mason/source/authors.txt create mode 100644 extra/mason/source/source.factor create mode 100644 extra/webapps/mason/make-release.xml create mode 100644 extra/webapps/mason/make-release/authors.txt create mode 100644 extra/webapps/mason/make-release/make-release.factor diff --git a/basis/bootstrap/image/download/download.factor b/basis/bootstrap/image/download/download.factor index 5bfc5f7ccc..e2de621984 100644 --- a/basis/bootstrap/image/download/download.factor +++ b/basis/bootstrap/image/download/download.factor @@ -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 diff --git a/extra/mason/server/release/release.factor b/extra/mason/server/release/release.factor index 8aae749839..04ca2955a7 100644 --- a/extra/mason/server/release/release.factor +++ b/extra/mason/server/release/release.factor @@ -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 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 ; diff --git a/extra/mason/source/authors.txt b/extra/mason/source/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/extra/mason/source/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/extra/mason/source/source.factor b/extra/mason/source/source.factor new file mode 100644 index 0000000000..3a3d6a66b7 --- /dev/null +++ b/extra/mason/source/source.factor @@ -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 ; diff --git a/extra/webapps/mason/grids/grids.factor b/extra/webapps/mason/grids/grids.factor index 57551b4aa5..86d9ba38b3 100644 --- a/extra/webapps/mason/grids/grids.factor +++ b/extra/webapps/mason/grids/grids.factor @@ -67,7 +67,12 @@ CONSTANT: cpus : ( -- action ) - [ package-grid xml>string "text/html" ] >>display ; + [ + [ + package-grid xml>string + "text/html" + ] with-mason-db + ] >>display ; : release-url ( builder -- url ) [ URL" $mason-app/release" ] dip @@ -90,4 +95,9 @@ CONSTANT: cpus : ( -- action ) - [ release-grid xml>string "text/html" ] >>display ; + [ + [ + release-grid xml>string + "text/html" + ] with-mason-db + ] >>display ; diff --git a/extra/webapps/mason/make-release.xml b/extra/webapps/mason/make-release.xml new file mode 100644 index 0000000000..f12ba014f2 --- /dev/null +++ b/extra/webapps/mason/make-release.xml @@ -0,0 +1,20 @@ + + + + + + + + + Make release + + + + Version: + + + + + + diff --git a/extra/webapps/mason/make-release/authors.txt b/extra/webapps/mason/make-release/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/extra/webapps/mason/make-release/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/extra/webapps/mason/make-release/make-release.factor b/extra/webapps/mason/make-release/make-release.factor new file mode 100644 index 0000000000..4cc3873d91 --- /dev/null +++ b/extra/webapps/mason/make-release/make-release.factor @@ -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 + +: ( -- action ) + + [ { { "version" [ v-one-line ] } } validate-params ] >>validate + [ + [ + "version" value do-release + "OK" "text/html" + ] with-mason-db + ] >>submit ; diff --git a/extra/webapps/mason/mason.factor b/extra/webapps/mason/mason.factor index 00e1b200f6..e134778fc7 100644 --- a/extra/webapps/mason/mason.factor +++ b/extra/webapps/mason/mason.factor @@ -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 + : ( -- dispatcher ) mason-app new-dispatcher - "report" add-responder + + "report" add-responder + { mason-app "download-package" } >>template "package" add-responder - "packages" add-responder + + "packages" add-responder { mason-app "download-release" } >>template "release" add-responder - "releases" add-responder - mason-db ; + + "releases" add-responder + + + { mason-app "make-release" } >>template + + + "make releases" >>description + { can-make-releases? } >>capabilities + + "make-release" add-responder ; diff --git a/extra/webapps/mason/package/package.factor b/extra/webapps/mason/package/package.factor index 0917eaa33a..d1ed03cbf4 100644 --- a/extra/webapps/mason/package/package.factor +++ b/extra/webapps/mason/package/package.factor @@ -54,18 +54,20 @@ IN: webapps.mason.package : ( -- 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 ; diff --git a/extra/webapps/mason/release/release.factor b/extra/webapps/mason/release/release.factor index e87b53fdfe..a7c0f71154 100644 --- a/extra/webapps/mason/release/release.factor +++ b/extra/webapps/mason/release/release.factor @@ -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 ; : ( -- 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 ; diff --git a/extra/webapps/mason/report/report.factor b/extra/webapps/mason/report/report.factor index f2d7542b9e..291ccb9bdb 100644 --- a/extra/webapps/mason/report/report.factor +++ b/extra/webapps/mason/report/report.factor @@ -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 : ( -- action ) - [ validate-os/cpu ] >>init - [ current-builder last-report>> "text/html" ] >>display ; + [ validate-os/cpu ] >>init + [ + [ + current-builder last-report>> + "text/html" + ] with-mason-db + ] >>display ; : report-link ( builder -- xml ) [ URL" report" ] dip diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor index 11b30a114c..fd4fb7515f 100644 --- a/extra/websites/concatenative/concatenative.factor +++ b/extra/websites/concatenative/concatenative.factor @@ -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" add-responder "pastebin" add-responder "planet" add-responder + "mason" add-responder "/tmp/docs/" "docs" add-responder test-db main-responder set-global ; @@ -97,9 +98,9 @@ SYMBOL: dh-file test-db "concatenative.org" add-responder test-db "paste.factorcode.org" add-responder test-db "planet.factorcode.org" add-responder + "builds.factorcode.org" add-responder home "docs" append-path "docs.factorcode.org" add-responder home "cgi" append-path "gitweb.factorcode.org" add-responder - "builds.factorcode.org" add-responder main-responder set-global ; : ( -- config )