farkup,webbrowser: better url validation

char-rename
Björn Lindqvist 2016-12-18 02:58:04 +01:00
parent 20a98a38fb
commit 88015e9632
3 changed files with 10 additions and 10 deletions

View File

@ -1,9 +1,9 @@
! Copyright (C) 2008, 2009 Doug Coleman, Daniel Ehrenberg. ! Copyright (C) 2008, 2009 Doug Coleman, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: sequences kernel splitting lists fry accessors assocs math.order USING: accessors arrays assocs combinators fry io.streams.string
math combinators namespaces urls.encoding xml.syntax xmode.code2html kernel lists locals math math.order namespaces sequences splitting
xml.data arrays strings vectors xml.writer io.streams.string locals strings urls urls.encoding xml.data xml.syntax xml.writer
unicode ; xmode.code2html ;
IN: farkup IN: farkup
SYMBOL: relative-link-prefix SYMBOL: relative-link-prefix
@ -33,7 +33,7 @@ TUPLE: line ;
TUPLE: line-break ; TUPLE: line-break ;
: absolute-url? ( string -- ? ) : absolute-url? ( string -- ? )
{ "http://" "https://" "ftp://" } [ head? ] with any? ; >url protocol>> >boolean ;
: simple-link-title ( string -- string' ) : simple-link-title ( string -- string' )
dup absolute-url? [ "/" split1-last swap or ] unless ; dup absolute-url? [ "/" split1-last swap or ] unless ;

View File

@ -3,5 +3,6 @@ IN: webbrowser
{ t } [ "http://reddit.com" url-string? ] unit-test { t } [ "http://reddit.com" url-string? ] unit-test
{ t } [ "https://reddit.com" url-string? ] unit-test { t } [ "https://reddit.com" url-string? ] unit-test
{ f } [ "ftp://reddit.com" url-string? ] unit-test { t } [ "ftp://reddit.com" url-string? ] unit-test
{ f } [ "moo" url-string? ] unit-test
{ f } [ 123 url-string? ] unit-test { f } [ 123 url-string? ] unit-test

View File

@ -1,8 +1,8 @@
! Copyright (C) 2011 John Benediktsson ! Copyright (C) 2011 John Benediktsson
! See http://factorcode.org/license.txt for BSD license ! See http://factorcode.org/license.txt for BSD license
USING: accessors combinators.short-circuit io.pathnames USING: accessors io.pathnames kernel sequences strings system
sequences strings system ui.operations urls vocabs ; ui.operations urls vocabs ;
IN: webbrowser IN: webbrowser
@ -17,7 +17,6 @@ HOOK: open-file os ( path -- )
[ url? ] \ open-url H{ } define-operation [ url? ] \ open-url H{ } define-operation
PREDICATE: url-string < string PREDICATE: url-string < string >url protocol>> >boolean ;
{ [ "http://" head? ] [ "https://" head? ] } 1|| ;
[ url-string? ] \ open-url H{ } define-operation [ url-string? ] \ open-url H{ } define-operation