extra/websites/concatenative/concatenative.factor

   1 ! Copyright (c) 2008, 2010 Slava Pestov
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors kernel sequences assocs io.files io.pathnames
   4 io.sockets io.sockets.secure io.servers
   5 namespaces db db.tuples db.sqlite smtp urls
   6 logging.insomniac calendar timers
   7 html.templates.chloe
   8 http.server
   9 http.server.dispatchers
  10 http.server.redirection
  11 http.server.static
  12 http.server.cgi
  13 furnace.alloy
  14 furnace.auth.login
  15 furnace.auth.providers.db
  16 furnace.auth.features.edit-profile
  17 furnace.auth.features.recover-password
  18 furnace.auth.features.registration
  19 furnace.auth.features.deactivate-user
  20 furnace.boilerplate
  21 furnace.redirection
  22 furnace.recaptcha
  23 webapps.pastebin
  24 webapps.planet
  25 webapps.wiki
  26 webapps.user-admin
  27 webapps.help
  28 webapps.mason
  29 webapps.mason.backend
  30 webapps.mason.backend.watchdog
  31 websites.factorcode ;
  32 IN: websites.concatenative
  33
  34 : website-db ( -- db ) "~/website.db" <sqlite-db> ;
  35
  36 : init-factor-db ( -- )
  37     mason-db [ init-mason-db ] with-db
  38
  39     website-db [
  40         init-furnace-tables
  41
  42         {
  43             paste-state annotation
  44             blog posting
  45             article revision
  46         } ensure-tables
  47     ] with-db ;
  48
  49 TUPLE: concatenative-website < dispatcher ;
  50
  51 : <factor-boilerplate> ( responder -- responder' )
  52     <boilerplate>
  53         { concatenative-website "page" } >>template ;
  54
  55 : <login-config> ( responder -- responder' )
  56     "Factor website" <login-realm>
  57         allow-registration
  58         allow-password-recovery
  59         allow-edit-profile
  60         allow-deactivation ;
  61
  62 SYMBOLS: factor-recaptcha-site-key factor-recaptcha-secret-key ;
  63
  64 : <factor-recaptcha> ( responder -- responder' )
  65     <recaptcha>
  66         "concatenative.org" >>domain
  67         factor-recaptcha-site-key get >>site-key
  68         factor-recaptcha-secret-key get >>secret-key ;
  69
  70 : <concatenative-website> ( -- responder )
  71     concatenative-website new-dispatcher
  72         URL" /wiki/view/Front Page" <redirect-responder> "" add-responder ;
  73
  74 SYMBOLS: key-password key-file dh-file ;
  75
  76 : common-configuration ( -- )
  77     "noreply@concatenative.org" lost-password-from set-global
  78     init-factor-db ;
  79
  80 : init-testing ( -- )
  81     "vocab:openssl/test/dh1024.pem" dh-file set-global
  82     "vocab:openssl/test/server.pem" key-file set-global
  83     "password" key-password set-global
  84     common-configuration
  85     <concatenative-website>
  86         <wiki> <factor-recaptcha> <login-config> <factor-boilerplate> "wiki" add-responder
  87         <user-admin> <login-config> <factor-boilerplate> "user-admin" add-responder
  88         <pastebin> <factor-recaptcha> <login-config> <factor-boilerplate> "pastebin" add-responder
  89         <planet> <login-config> <factor-boilerplate> "planet" add-responder
  90         <mason-app> <login-config> <factor-boilerplate> "mason" add-responder
  91         "/tmp/docs/" <help-webapp> "docs" add-responder
  92     website-db <alloy>
  93     main-responder set-global ;
  94
  95 : <gitweb> ( path -- responder )
  96     <dispatcher>
  97         swap <static> enable-cgi >>default
  98         URL" /gitweb.cgi" <redirect-responder> "" add-responder
  99         URL" /github-sync.cgi" <redirect-responder> "github-sync" add-responder ;
 100
 101 TUPLE: cgit < file-responder cgi ;
 102
 103 : <cgit> ( root cgi -- responder )
 104     cgit new
 105         swap >>cgi
 106         swap >>root
 107         [ (serve-static) ] >>hook
 108         H{ } clone >>special ;
 109
 110 M: cgit call-responder*
 111     dup file-responder set
 112     over [ f ] [ "/" join serving-path file-exists? ] if-empty [
 113         call-next-method
 114     ] [
 115         url get
 116             rot "/" join "url" set-query-param
 117             "cgit.cgi" >>path drop
 118         cgi>> serve-cgi
 119     ] if ;
 120
 121 : init-production ( -- )
 122     common-configuration
 123     <vhost-dispatcher>
 124         <concatenative-website>
 125             <wiki> <factor-recaptcha> "wiki" add-responder
 126             <user-admin> "user-admin" add-responder
 127         <login-config> <factor-boilerplate> website-db <alloy> "concatenative.org" add-responder
 128         <pastebin> <factor-recaptcha> <login-config> <factor-boilerplate> website-db <alloy> "paste.factorcode.org" add-responder
 129         <planet> <login-config> <factor-boilerplate> website-db <alloy> "planet.factorcode.org" add-responder
 130         <mason-app> <login-config> <factor-boilerplate> website-db <alloy> "builds.factorcode.org" add-responder
 131         "~/docs" <help-webapp> "docs.factorcode.org" add-responder
 132         "~/gitweb" <gitweb> "gitweb.factorcode.org" add-responder
 133         "/usr/share/cgit" "/usr/lib/cgit/cgit.cgi" <cgit> "cgit.factorcode.org" add-responder
 134         "~/irclogs" <static> t >>allow-listings "irclogs.factorcode.org" add-responder
 135     main-responder set-global ;
 136
 137 : <factor-secure-config> ( -- config )
 138     <secure-config>
 139         key-file get >>key-file
 140         dh-file get >>dh-file
 141         key-password get >>password ;
 142
 143 : <concatenative-website-server> ( -- threaded-server )
 144     <http-server>
 145         <factor-secure-config> >>secure-config
 146         8080 >>insecure
 147         8431 >>secure ;
 148
 149 : start-watchdog ( -- )
 150     [ check-builders ] 6 hours every drop ;
 151
 152 : start-website ( -- server )
 153     website-db start-expiring
 154     website-db start-update-task
 155     http-insomniac
 156     start-watchdog
 157     <concatenative-website-server> start-server ;