2010-02-14 07:03:15 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								! Copyright (c) 2008, 2010 Slava Pestov
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-17 01:10:46 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-15 02:13:35 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								USING: accessors kernel sequences assocs io.files io.pathnames
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								io.sockets io.sockets.secure io.servers.connection
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-17 01:10:46 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								namespaces db db.tuples db.sqlite smtp urls
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								logging.insomniac
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-08 02:11:36 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								html.templates.chloe
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-17 01:10:46 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								http.server
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								http.server.dispatchers
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								http.server.redirection
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-29 22:18:49 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								http.server.static
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								http.server.cgi
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-17 01:10:46 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								furnace.alloy
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								furnace.auth.login
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								furnace.auth.providers.db
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								furnace.auth.features.edit-profile
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								furnace.auth.features.recover-password
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								furnace.auth.features.registration
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-18 04:26:50 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								furnace.auth.features.deactivate-user
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-17 01:10:46 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								furnace.boilerplate
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								furnace.redirection
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								webapps.pastebin
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								webapps.planet
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								webapps.wiki
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-29 06:13:44 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								webapps.user-admin
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-22 18:52:31 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								webapps.help
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								webapps.mason ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-17 01:10:46 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: websites.concatenative
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-10-02 17:36:29 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: test-db ( -- db ) "resource:test.db" <sqlite-db> ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-17 01:10:46 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: init-factor-db ( -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    test-db [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        init-furnace-tables
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        {
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            paste annotation
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            blog posting
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            article revision
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        } ensure-tables
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] with-db ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								TUPLE: factor-website < dispatcher ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-29 05:10:29 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: <factor-boilerplate> ( responder -- responder' )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    <boilerplate>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        { factor-website "page" } >>template ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-30 00:04:14 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: <login-config> ( responder -- responder' )
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-17 01:10:46 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    "Factor website" <login-realm>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        "Factor website" >>name
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        allow-registration
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        allow-password-recovery
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        allow-edit-profile
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-30 00:05:21 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        allow-deactivation ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-17 01:10:46 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-28 20:39:26 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: <factor-website> ( -- responder )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    factor-website new-dispatcher
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        URL" /wiki/view/Front Page" <redirect-responder> "" add-responder ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-18 04:40:05 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								SYMBOL: key-password
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								SYMBOL: key-file
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								SYMBOL: dh-file
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: common-configuration ( -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    "concatenative.org" 25 <inet> smtp-server set-global
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-18 03:54:11 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    "noreply@concatenative.org" lost-password-from set-global
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    "website@concatenative.org" insomniac-sender set-global
							 | 
						
					
						
							
								
									
										
										
										
											2009-02-08 01:20:56 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    { "slava@factorcode.org" } insomniac-recipients set-global
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-18 04:40:05 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    init-factor-db ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: init-testing ( -- )
							 | 
						
					
						
							
								
									
										
										
										
											2009-02-15 20:53:21 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    "vocab:openssl/test/dh1024.pem" dh-file set-global
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    "vocab:openssl/test/server.pem" key-file set-global
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-18 04:40:05 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    "password" key-password set-global
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-10 21:07:00 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    common-configuration
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-28 20:39:26 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    <factor-website>
							 | 
						
					
						
							
								
									
										
										
										
											2009-01-31 02:01:54 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        <wiki> <login-config> <factor-boilerplate> "wiki" add-responder
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        <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
							 | 
						
					
						
							
								
									
										
										
										
											2010-02-14 07:03:15 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        <mason-app> <login-config> "mason" add-responder
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-29 06:14:34 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        "/tmp/docs/" <help-webapp> "docs" add-responder
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-30 00:04:14 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    test-db <alloy>
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-28 20:39:26 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    main-responder set-global ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-10 21:07:00 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-29 22:18:49 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: <gitweb> ( path -- responder )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    <dispatcher>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        swap <static> enable-cgi >>default
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        URL" /gitweb.cgi" <redirect-responder> "" add-responder ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-18 04:40:05 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: init-production ( -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-10 21:07:00 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    common-configuration
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    <vhost-dispatcher>
							 | 
						
					
						
							
								
									
										
										
										
											2009-09-18 17:35:53 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        <factor-website>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            <wiki> "wiki" add-responder
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            <user-admin> "user-admin" add-responder
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        <login-config> <factor-boilerplate> test-db <alloy> "concatenative.org" add-responder
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-30 00:08:37 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        <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
							 | 
						
					
						
							
								
									
										
										
										
											2010-02-14 07:03:15 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        <mason-app> <login-config> "builds.factorcode.org" add-responder
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-07 12:59:59 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        home "docs" append-path <help-webapp> "docs.factorcode.org" add-responder
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-29 22:18:49 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        home "cgi" append-path <gitweb> "gitweb.factorcode.org" add-responder
							 | 
						
					
						
							
								
									
										
										
										
											2008-09-10 21:07:00 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    main-responder set-global ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-17 01:10:46 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: <factor-secure-config> ( -- config )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    <secure-config>
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-18 04:40:05 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        key-file get >>key-file
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        dh-file get >>dh-file
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        key-password get >>password ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-17 01:10:46 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: <factor-website-server> ( -- threaded-server )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    <http-server>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        <factor-secure-config> >>secure-config
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        8080 >>insecure
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        8431 >>secure ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-18 04:40:05 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: start-website ( -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-17 01:10:46 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    test-db start-expiring
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    test-db start-update-task
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    http-insomniac
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    <factor-website-server> start-server ;
							 |