Harden farkup against cross-site scripting

db4
Slava Pestov 2008-06-13 22:05:02 -05:00
parent e7b786ecfa
commit a687b58226
1 changed files with 15 additions and 9 deletions

View File

@ -1,8 +1,8 @@
! Copyright (C) 2008 Doug Coleman. ! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays io io.styles kernel memoize namespaces peg USING: arrays io io.styles kernel memoize namespaces peg math
sequences strings html.elements xml.entities xmode.code2html combinators sequences strings html.elements xml.entities
splitting io.streams.string peg.parsers xmode.code2html splitting io.streams.string peg.parsers
sequences.deep unicode.categories ; sequences.deep unicode.categories ;
IN: farkup IN: farkup
@ -67,13 +67,19 @@ MEMO: eq ( -- parser )
</pre> </pre>
] with-string-writer ; ] with-string-writer ;
: invalid-url "javascript:alert('Invalid URL in farkup');" ;
: check-url ( href -- href' ) : check-url ( href -- href' )
CHAR: : over member? [ {
dup { "http://" "https://" "ftp://" } [ head? ] with contains? { [ dup empty? ] [ drop invalid-url ] }
[ drop "/" ] unless { [ dup [ 127 > ] contains? ] [ drop invalid-url ] }
] [ { [ dup first "/\\" member? ] [ drop invalid-url ] }
relative-link-prefix get prepend { [ CHAR: : over member? ] [
] if ; 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 ) : escape-link ( href text -- href-esc text-esc )
>r check-url escape-quoted-string r> escape-string ; >r check-url escape-quoted-string r> escape-string ;