extra/mason/mason.factor

   1 ! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors calendar continuations debugger io
   4 io.directories io.pathnames io.sockets io.streams.string kernel
   5 make mason.build mason.common mason.config mason.disk
   6 mason.email mason.notify mason.updates namespaces prettyprint
   7 sequences threads ;
   8 IN: mason
   9
  10 : heartbeat-loop ( -- )
  11     notify-heartbeat
  12     5 minutes sleep
  13     heartbeat-loop ;
  14
  15 : fatal-error-body ( error callstack -- string )
  16     [
  17         "Fatal error on " write host-name print nl
  18         [ error. ] [ callstack. ] bi*
  19     ] with-string-writer ;
  20
  21 : build-loop-error ( error callstack -- )
  22     fatal-error-body
  23     "build loop error"
  24     email-fatal ;
  25
  26 : build-loop ( -- )
  27     [
  28         builds-dir get make-directories
  29         builds-dir get [
  30             check-disk-space
  31             update-sources
  32             should-build? [ do-build ] [ 5 minutes sleep ] if
  33         ] with-directory
  34     ] [
  35         error-continuation get call>> build-loop-error
  36         5 minutes sleep
  37     ] recover
  38
  39     build-loop ;
  40
  41 : check-host ( user host -- )
  42     "@" glue [
  43         scp-command get ,
  44         "resource:LICENSE.txt" absolute-path canonicalize-path ,
  45         ":" append ,
  46     ] { } make short-running-process ;
  47
  48 : check-hosts ( -- )
  49     branch-username get branch-host get check-host
  50     package-username get package-host get check-host
  51     image-username get image-host get check-host
  52     upload-docs? get [
  53         docs-username get docs-host get check-host
  54     ] when ;
  55
  56 : run-mason ( -- )
  57     check-hosts
  58     [ heartbeat-loop ] "Heartbeat loop" spawn
  59     [ build-loop ] "Build loop" spawn
  60     stop ;
  61
  62 MAIN: run-mason