diff --git a/core/vectors/vectors-tests.factor b/core/vectors/vectors-tests.factor index 7f4abe3222..3b2c94b2e5 100755 --- a/core/vectors/vectors-tests.factor +++ b/core/vectors/vectors-tests.factor @@ -26,7 +26,7 @@ IN: vectors.tests [ V{ 1 2 } ] [ [ 1 2 ] >vector ] unit-test [ t ] [ - 100 [ 100 random ] V{ } map-as + 100 [ 100 random ] V{ } replicate-as dup >array >vector = ] unit-test diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor index c7c9065b43..38a3899fc4 100755 --- a/extra/db/sqlite/sqlite.factor +++ b/extra/db/sqlite/sqlite.factor @@ -53,7 +53,7 @@ M: sqlite-result-set dispose ( result-set -- ) M: sqlite-statement low-level-bind ( statement -- ) [ statement-bind-params ] [ statement-handle ] bi - swap [ [ key>> ] [ value>> ] [ type>> ] tri sqlite-bind-type ] with each ; + [ swap [ key>> ] [ value>> ] [ type>> ] tri sqlite-bind-type ] curry each ; M: sqlite-statement bind-statement* ( statement -- ) sqlite-maybe-prepare diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor index 4903adff5c..e02e21cbe6 100755 --- a/extra/db/tuples/tuples.factor +++ b/extra/db/tuples/tuples.factor @@ -122,6 +122,9 @@ M: retryable execute-statement* ( statement type -- ) : ensure-table ( class -- ) [ create-table ] curry ignore-errors ; +: ensure-tables ( classes -- ) + [ ensure-table ] each ; + : insert-db-assigned-statement ( tuple -- ) dup class db get db-insert-statements [ ] cache diff --git a/extra/editors/gvim/gvim.factor b/extra/editors/gvim/gvim.factor index 62150bdf49..041f3db675 100755 --- a/extra/editors/gvim/gvim.factor +++ b/extra/editors/gvim/gvim.factor @@ -3,14 +3,12 @@ namespaces sequences system combinators editors.vim editors.gvim.backend vocabs.loader ; IN: editors.gvim -TUPLE: gvim ; +SINGLETON: gvim M: gvim vim-command ( file line -- string ) - [ "\"" % gvim-path % "\" \"" % swap % "\" +" % # ] "" make ; + [ gvim-path , swap , "+" swap number>string append , ] { } make ; -t vim-detach set-global ! don't block the ui - -T{ gvim } vim-editor set-global +gvim vim-editor set-global { { [ os unix? ] [ "editors.gvim.unix" ] } diff --git a/extra/editors/vim/vim-docs.factor b/extra/editors/vim/vim-docs.factor index 020117564d..cf42884084 100644 --- a/extra/editors/vim/vim-docs.factor +++ b/extra/editors/vim/vim-docs.factor @@ -11,7 +11,5 @@ $nl "USE: vim" "\"c:\\\\program files\\\\vim\\\\vim70\\\\gvim\" vim-path set-global" } -"On Unix, you may omit the last line if " { $snippet "\"vim\"" } " is in your " { $snippet "$PATH" } "." -$nl -"If you are running the terminal version of Vim, you want it to block Factor until exiting, but for GVim the opposite is desired, so that one can work in Factor and GVim concurrently. The " { $link vim-detach } " global variable can be set to " { $link t } " to detach the Vim process. The default is " { $link f } "." ; +"On Unix, you may omit the last line if " { $snippet "\"vim\"" } " is in your " { $snippet "$PATH" } "." ; diff --git a/extra/editors/vim/vim.factor b/extra/editors/vim/vim.factor index 9ce256868b..bfbb8f15a5 100755 --- a/extra/editors/vim/vim.factor +++ b/extra/editors/vim/vim.factor @@ -3,24 +3,20 @@ namespaces parser prettyprint sequences editors accessors ; IN: editors.vim SYMBOL: vim-path -SYMBOL: vim-detach SYMBOL: vim-editor -HOOK: vim-command vim-editor +HOOK: vim-command vim-editor ( file line -- array ) -TUPLE: vim ; +SINGLETON: vim -M: vim vim-command ( file line -- array ) +M: vim vim-command [ vim-path get , swap , "+" swap number>string append , ] { } make ; : vim-location ( file line -- ) - vim-command - swap >>command - vim-detach get-global [ t >>detached ] when - try-process ; + vim-command try-process ; "vim" vim-path set-global [ vim-location ] edit-hook set-global -T{ vim } vim-editor set-global +vim vim-editor set-global diff --git a/extra/farkup/farkup.factor b/extra/farkup/farkup.factor index 1b51bb5752..321648136a 100755 --- a/extra/farkup/farkup.factor +++ b/extra/farkup/farkup.factor @@ -1,12 +1,13 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays io io.styles kernel memoize namespaces peg -sequences strings html.elements xml.entities xmode.code2html -splitting io.streams.string peg.parsers +USING: arrays io io.styles kernel memoize namespaces peg math +combinators sequences strings html.elements xml.entities +xmode.code2html splitting io.streams.string peg.parsers sequences.deep unicode.categories ; IN: farkup SYMBOL: relative-link-prefix +SYMBOL: disable-images? SYMBOL: link-no-follow? ] with-string-writer ; +: invalid-url "javascript:alert('Invalid URL in farkup');" ; + : check-url ( href -- href' ) - CHAR: : over member? [ - dup { "http://" "https://" "ftp://" } [ head? ] with contains? - [ drop "/" ] unless - ] [ - relative-link-prefix get prepend - ] if ; + { + { [ dup empty? ] [ drop invalid-url ] } + { [ dup [ 127 > ] contains? ] [ drop invalid-url ] } + { [ dup first "/\\" member? ] [ drop invalid-url ] } + { [ CHAR: : over member? ] [ + dup { "http://" "https://" "ftp://" } [ head? ] with contains? + [ drop invalid-url ] unless + ] } + [ relative-link-prefix get prepend ] + } cond ; : escape-link ( href text -- href-esc text-esc ) >r check-url escape-quoted-string r> escape-string ; @@ -82,18 +89,22 @@ MEMO: eq ( -- parser ) escape-link [ "r , r> + " href=\"" , >r , r> "\"" , link-no-follow? get [ " nofollow=\"true\"" , ] when - "\">" , , "" , + ">" , , "" , ] { } make ; : make-image-link ( href alt -- seq ) - escape-link - [ - "\""" , ] - { } make ; + disable-images? get [ + 2drop "Images are not allowed" + ] [ + escape-link + [ + "\""" , + ] { } make + ] if ; MEMO: image-link ( -- parser ) [ diff --git a/extra/furnace/actions/actions.factor b/extra/furnace/actions/actions.factor index a281687096..9cc1880cc3 100755 --- a/extra/furnace/actions/actions.factor +++ b/extra/furnace/actions/actions.factor @@ -53,7 +53,7 @@ TUPLE: action rest authorize init display validate submit ; ] with-exit-continuation ; : validation-failed ( -- * ) - request get method>> "POST" = [ f ] [ <400> ] if exit-with ; + post-request? [ f ] [ <400> ] if exit-with ; : (handle-post) ( action -- response ) '[ @@ -70,16 +70,13 @@ TUPLE: action rest authorize init display validate submit ; : revalidate-url-key "__u" ; -: check-url ( url -- ? ) - request get url>> - [ [ protocol>> ] [ host>> ] [ port>> ] tri 3array ] bi@ = ; - : revalidate-url ( -- url/f ) - revalidate-url-key param dup [ >url dup check-url swap and ] when ; + revalidate-url-key param + dup [ >url [ same-host? ] keep and ] when ; : handle-post ( action -- response ) '[ - form-nesting-key params get at " " split + form-nesting-key params get at " " split harvest [ , (handle-post) ] [ swap '[ , , nest-values ] ] reduce call diff --git a/extra/furnace/alloy/alloy.factor b/extra/furnace/alloy/alloy.factor new file mode 100644 index 0000000000..14ffbaba9d --- /dev/null +++ b/extra/furnace/alloy/alloy.factor @@ -0,0 +1,31 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel sequences db.tuples alarms calendar db fry +furnace.cache +furnace.asides +furnace.flash +furnace.sessions +furnace.referrer +furnace.db +furnace.auth.providers ; +IN: furnace.alloy + +: ( responder db params -- responder' ) + '[ + + + + , , + + ] call ; + +: state-classes { session flash-scope aside } ; inline + +: init-furnace-tables ( -- ) + state-classes ensure-tables + user ensure-table ; + +: start-expiring ( db params -- ) + '[ + , , [ state-classes [ expire-state ] each ] with-db + ] 5 minutes every drop ; diff --git a/extra/furnace/asides/asides.factor b/extra/furnace/asides/asides.factor index f6b4e2c15f..15d1c1df0b 100644 --- a/extra/furnace/asides/asides.factor +++ b/extra/furnace/asides/asides.factor @@ -2,37 +2,60 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors namespaces sequences arrays kernel assocs assocs.lib hashtables math.parser urls combinators -furnace http http.server http.server.filters furnace.sessions -html.elements html.templates.chloe.syntax ; +html.elements html.templates.chloe.syntax db.types db.tuples +http http.server http.server.filters +furnace furnace.cache furnace.sessions ; IN: furnace.asides -TUPLE: asides < filter-responder ; +TUPLE: aside < server-state session method url post-data ; -C: asides +: