steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
John Benediktsson 2009-04-07 13:59:59 -07:00
parent d39aa343b5 65802b6aaa
commit 9f6f53e571
8 changed files with 381 additions and 338 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
basis/http/client/client.factor
View File

@ -6,7 +6,7 @@ math.order hashtables byte-arrays destructors
io io.sockets io.streams.string io.files io.timeouts io io.sockets io.streams.string io.files io.timeouts
io.pathnames io.encodings io.encodings.string io.encodings.ascii io.pathnames io.encodings io.encodings.string io.encodings.ascii
io.encodings.utf8 io.encodings.8-bit io.encodings.binary io.crlf io.encodings.utf8 io.encodings.8-bit io.encodings.binary io.crlf
io.streams.duplex fry ascii urls urls.encoding present io.streams.duplex fry ascii urls urls.encoding present locals
http http.parsers http.client.post-data ; http http.parsers http.client.post-data ;
IN: http.client IN: http.client
@ -77,12 +77,13 @@ SYMBOL: redirects
: redirect? ( response -- ? ) : redirect? ( response -- ? )
code>> 300 399 between? ; code>> 300 399 between? ;
: do-redirect ( quot: ( chunk -- ) response -- response ) :: do-redirect ( quot: ( chunk -- ) response -- response )
redirects inc redirects inc
redirects get max-redirects < [ redirects get max-redirects < [
request get clone request get clone
swap "location" header redirect-url response "location" header redirect-url
"GET" >>method swap (with-http-request) response code>> 307 = [ "GET" >>method ] unless
quot (with-http-request)
] [ too-many-redirects ] if ; inline recursive ] [ too-many-redirects ] if ; inline recursive
: read-chunk-size ( -- n ) : read-chunk-size ( -- n )

43
basis/http/http-tests.factor
View File

@ -1,8 +1,8 @@
USING: http http.server http.client http.client.private tools.test multiline USING: http http.server http.client http.client.private tools.test
io.streams.string io.encodings.utf8 io.encodings.8-bit multiline io.streams.string io.encodings.utf8 io.encodings.8-bit
io.encodings.binary io.encodings.string kernel arrays splitting io.encodings.binary io.encodings.string io.encodings.ascii kernel
sequences assocs io.sockets db db.sqlite continuations urls arrays splitting sequences assocs io.sockets db db.sqlite
hashtables accessors namespaces xml.data ; continuations urls hashtables accessors namespaces xml.data ;
IN: http.tests IN: http.tests
[ "text/plain" latin1 ] [ "text/plain" parse-content-type ] unit-test [ "text/plain" latin1 ] [ "text/plain" parse-content-type ] unit-test
@ -359,4 +359,37 @@ SYMBOL: a
! Test basic auth ! Test basic auth
[ "Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==" ] [ <request> "Aladdin" "open sesame" set-basic-auth "Authorization" header ] unit-test [ "Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==" ] [ <request> "Aladdin" "open sesame" set-basic-auth "Authorization" header ] unit-test
! Test a corner case with static responder
[ ] [
<dispatcher>
add-quit-action
"vocab:http/test/foo.html" <static> >>default
test-httpd
] unit-test
[ t ] [
"http://localhost/" add-port http-get nip
"vocab:http/test/foo.html" ascii file-contents =
] unit-test
[ ] [ "http://localhost/quit" add-port http-get 2drop ] unit-test
! Check behavior of 307 redirect (reported by Chris Double)
[ ] [
<dispatcher>
add-quit-action
<action>
[ "b" <temporary-redirect> ] >>submit
"a" add-responder
<action>
[
request get post-data>> data>> "data" =
[ "OK" "text/plain" <content> ] [ "OOPS" throw ] if
] >>submit
"b" add-responder
test-httpd
] unit-test
[ "OK" ] [ "data" "http://localhost/a" add-port http-post nip ] unit-test
[ ] [ "http://localhost/quit" add-port http-get 2drop ] unit-test

4
basis/http/server/static/static.factor
View File

@ -47,8 +47,8 @@ TUPLE: file-responder root hook special allow-listings ;
if ; if ;
: serving-path ( filename -- filename ) : serving-path ( filename -- filename )
[ file-responder get root>> trim-tail-separators "/" ] dip [ file-responder get root>> trim-tail-separators ] dip
"" or trim-head-separators 3append ; [ "/" swap trim-head-separators 3append ] unless-empty ;
: serve-file ( filename -- response ) : serve-file ( filename -- response )
dup mime-type dup mime-type

6
basis/io/streams/limited/limited-tests.factor
View File

@ -76,3 +76,9 @@ IN: io.streams.limited.tests
[ decoder? ] both? [ decoder? ] both?
] with-destructors ] with-destructors
] unit-test ] unit-test
[ "HELL" ] [
"HELLO"
[ f stream-throws limit-input 4 read ]
with-string-reader
] unit-test

8
basis/io/streams/limited/limited.factor
View File

@ -22,7 +22,7 @@ M: decoder limit ( stream limit mode -- stream' )
[ clone ] 2dip '[ _ _ limit ] change-stream ; [ clone ] 2dip '[ _ _ limit ] change-stream ;
M: object limit ( stream limit mode -- stream' ) M: object limit ( stream limit mode -- stream' )
<limited-stream> ; over [ <limited-stream> ] [ 2drop ] if ;
GENERIC: unlimited ( stream -- stream' ) GENERIC: unlimited ( stream -- stream' )
@ -32,9 +32,11 @@ M: decoder unlimited ( stream -- stream' )
M: object unlimited ( stream -- stream' ) M: object unlimited ( stream -- stream' )
stream>> stream>> ; stream>> stream>> ;
: limit-input ( limit mode -- ) input-stream [ -rot limit ] change ; : limit-input ( limit mode -- )
[ input-stream ] 2dip '[ _ _ limit ] change ;
: unlimited-input ( -- ) input-stream [ unlimited ] change ; : unlimited-input ( -- )
input-stream [ unlimited ] change ;
: with-unlimited-stream ( stream quot -- ) : with-unlimited-stream ( stream quot -- )
[ clone unlimited ] dip call ; inline [ clone unlimited ] dip call ; inline

79
extra/robots/robots-tests.factor
View File

@ -1,6 +1,7 @@
! Copyright (C) 2009 Doug Coleman. ! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: calendar io.encodings.utf8 io.files robots tools.test ; USING: calendar io.encodings.utf8 io.files robots tools.test
urls ;
IN: robots.tests IN: robots.tests
[ [
@ -11,16 +12,16 @@ IN: robots.tests
{ allows V{ } } { allows V{ } }
{ disallows { disallows
V{ V{
"/cgi-bin/" URL" /cgi-bin/"
"/scripts/" URL" /scripts/"
"/ChipList2/scripts/" URL" /ChipList2/scripts/"
"/ChipList2/styles/" URL" /ChipList2/styles/"
"/ads/" URL" /ads/"
"/ChipList2/ads/" URL" /ChipList2/ads/"
"/advertisements/" URL" /advertisements/"
"/ChipList2/advertisements/" URL" /ChipList2/advertisements/"
"/graphics/" URL" /graphics/"
"/ChipList2/graphics/" URL" /ChipList2/graphics/"
} }
} }
{ visit-time { visit-time
@ -36,163 +37,163 @@ IN: robots.tests
T{ rules T{ rules
{ user-agents V{ "UbiCrawler" } } { user-agents V{ "UbiCrawler" } }
{ allows V{ } } { allows V{ } }
{ disallows V{ "/" } } { disallows V{ URL" /" } }
{ unknowns H{ } } { unknowns H{ } }
} }
T{ rules T{ rules
{ user-agents V{ "DOC" } } { user-agents V{ "DOC" } }
{ allows V{ } } { allows V{ } }
{ disallows V{ "/" } } { disallows V{ URL" /" } }
{ unknowns H{ } } { unknowns H{ } }
} }
T{ rules T{ rules
{ user-agents V{ "Zao" } } { user-agents V{ "Zao" } }
{ allows V{ } } { allows V{ } }
{ disallows V{ "/" } } { disallows V{ URL" /" } }
{ unknowns H{ } } { unknowns H{ } }
} }
T{ rules T{ rules
{ user-agents V{ "sitecheck.internetseer.com" } } { user-agents V{ "sitecheck.internetseer.com" } }
{ allows V{ } } { allows V{ } }
{ disallows V{ "/" } } { disallows V{ URL" /" } }
{ unknowns H{ } } { unknowns H{ } }
} }
T{ rules T{ rules
{ user-agents V{ "Zealbot" } } { user-agents V{ "Zealbot" } }
{ allows V{ } } { allows V{ } }
{ disallows V{ "/" } } { disallows V{ URL" /" } }
{ unknowns H{ } } { unknowns H{ } }
} }
T{ rules T{ rules
{ user-agents V{ "MSIECrawler" } } { user-agents V{ "MSIECrawler" } }
{ allows V{ } } { allows V{ } }
{ disallows V{ "/" } } { disallows V{ URL" /" } }
{ unknowns H{ } } { unknowns H{ } }
} }
T{ rules T{ rules
{ user-agents V{ "SiteSnagger" } } { user-agents V{ "SiteSnagger" } }
{ allows V{ } } { allows V{ } }
{ disallows V{ "/" } } { disallows V{ URL" /" } }
{ unknowns H{ } } { unknowns H{ } }
} }
T{ rules T{ rules
{ user-agents V{ "WebStripper" } } { user-agents V{ "WebStripper" } }
{ allows V{ } } { allows V{ } }
{ disallows V{ "/" } } { disallows V{ URL" /" } }
{ unknowns H{ } } { unknowns H{ } }
} }
T{ rules T{ rules
{ user-agents V{ "WebCopier" } } { user-agents V{ "WebCopier" } }
{ allows V{ } } { allows V{ } }
{ disallows V{ "/" } } { disallows V{ URL" /" } }
{ unknowns H{ } } { unknowns H{ } }
} }
T{ rules T{ rules
{ user-agents V{ "Fetch" } } { user-agents V{ "Fetch" } }
{ allows V{ } } { allows V{ } }
{ disallows V{ "/" } } { disallows V{ URL" /" } }
{ unknowns H{ } } { unknowns H{ } }
} }
T{ rules T{ rules
{ user-agents V{ "Offline Explorer" } } { user-agents V{ "Offline Explorer" } }
{ allows V{ } } { allows V{ } }
{ disallows V{ "/" } } { disallows V{ URL" /" } }
{ unknowns H{ } } { unknowns H{ } }
} }
T{ rules T{ rules
{ user-agents V{ "Teleport" } } { user-agents V{ "Teleport" } }
{ allows V{ } } { allows V{ } }
{ disallows V{ "/" } } { disallows V{ URL" /" } }
{ unknowns H{ } } { unknowns H{ } }
} }
T{ rules T{ rules
{ user-agents V{ "TeleportPro" } } { user-agents V{ "TeleportPro" } }
{ allows V{ } } { allows V{ } }
{ disallows V{ "/" } } { disallows V{ URL" /" } }
{ unknowns H{ } } { unknowns H{ } }
} }
T{ rules T{ rules
{ user-agents V{ "WebZIP" } } { user-agents V{ "WebZIP" } }
{ allows V{ } } { allows V{ } }
{ disallows V{ "/" } } { disallows V{ URL" /" } }
{ unknowns H{ } } { unknowns H{ } }
} }
T{ rules T{ rules
{ user-agents V{ "linko" } } { user-agents V{ "linko" } }
{ allows V{ } } { allows V{ } }
{ disallows V{ "/" } } { disallows V{ URL" /" } }
{ unknowns H{ } } { unknowns H{ } }
} }
T{ rules T{ rules
{ user-agents V{ "HTTrack" } } { user-agents V{ "HTTrack" } }
{ allows V{ } } { allows V{ } }
{ disallows V{ "/" } } { disallows V{ URL" /" } }
{ unknowns H{ } } { unknowns H{ } }
} }
T{ rules T{ rules
{ user-agents V{ "Microsoft.URL.Control" } } { user-agents V{ "Microsoft.URL.Control" } }
{ allows V{ } } { allows V{ } }
{ disallows V{ "/" } } { disallows V{ URL" /" } }
{ unknowns H{ } } { unknowns H{ } }
} }
T{ rules T{ rules
{ user-agents V{ "Xenu" } } { user-agents V{ "Xenu" } }
{ allows V{ } } { allows V{ } }
{ disallows V{ "/" } } { disallows V{ URL" /" } }
{ unknowns H{ } } { unknowns H{ } }
} }
T{ rules T{ rules
{ user-agents V{ "larbin" } } { user-agents V{ "larbin" } }
{ allows V{ } } { allows V{ } }
{ disallows V{ "/" } } { disallows V{ URL" /" } }
{ unknowns H{ } } { unknowns H{ } }
} }
T{ rules T{ rules
{ user-agents V{ "libwww" } } { user-agents V{ "libwww" } }
{ allows V{ } } { allows V{ } }
{ disallows V{ "/" } } { disallows V{ URL" /" } }
{ unknowns H{ } } { unknowns H{ } }
} }
T{ rules T{ rules
{ user-agents V{ "ZyBORG" } } { user-agents V{ "ZyBORG" } }
{ allows V{ } } { allows V{ } }
{ disallows V{ "/" } } { disallows V{ URL" /" } }
{ unknowns H{ } } { unknowns H{ } }
} }
T{ rules T{ rules
{ user-agents V{ "Download Ninja" } } { user-agents V{ "Download Ninja" } }
{ allows V{ } } { allows V{ } }
{ disallows V{ "/" } } { disallows V{ URL" /" } }
{ unknowns H{ } } { unknowns H{ } }
} }
T{ rules T{ rules
{ user-agents V{ "wget" } } { user-agents V{ "wget" } }
{ allows V{ } } { allows V{ } }
{ disallows V{ "/" } } { disallows V{ URL" /" } }
{ unknowns H{ } } { unknowns H{ } }
} }
T{ rules T{ rules
{ user-agents V{ "grub-client" } } { user-agents V{ "grub-client" } }
{ allows V{ } } { allows V{ } }
{ disallows V{ "/" } } { disallows V{ URL" /" } }
{ unknowns H{ } } { unknowns H{ } }
} }
T{ rules T{ rules
{ user-agents V{ "k2spider" } } { user-agents V{ "k2spider" } }
{ allows V{ } } { allows V{ } }
{ disallows V{ "/" } } { disallows V{ URL" /" } }
{ unknowns H{ } } { unknowns H{ } }
} }
T{ rules T{ rules
{ user-agents V{ "NPBot" } } { user-agents V{ "NPBot" } }
{ allows V{ } } { allows V{ } }
{ disallows V{ "/" } } { disallows V{ URL" /" } }
{ unknowns H{ } } { unknowns H{ } }
} }
T{ rules T{ rules
{ user-agents V{ "WebReaper" } } { user-agents V{ "WebReaper" } }
{ allows V{ } } { allows V{ } }
{ disallows V{ "/" } } { disallows V{ URL" /" } }
{ unknowns H{ } } { unknowns H{ } }
} }
T{ rules T{ rules
@ -327,7 +328,7 @@ IN: robots.tests
} }
} }
{ allows V{ } } { allows V{ } }
{ disallows V{ "/" } } { disallows V{ URL" /" } }
{ unknowns H{ } } { unknowns H{ } }
} }
} }

2
extra/robots/robots.factor
View File

@ -85,7 +85,7 @@ PRIVATE>
: parse-robots.txt ( string -- sitemaps rules-seq ) : parse-robots.txt ( string -- sitemaps rules-seq )
normalize-robots.txt [ normalize-robots.txt [
[ <rules> dup ] dip [ parse-robots.txt-line drop ] with each [ <rules> dup ] dip [ parse-robots.txt-line drop ] with each
] map first ; ] map ;
: robots ( url -- robots ) : robots ( url -- robots )
>url >url

2
extra/site-watcher/site-watcher-tests.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: db.tuples locals site-watcher site-watcher.db USING: db.tuples locals site-watcher site-watcher.db
site-watcher.private kernel db io.directories io.files.temp site-watcher.private kernel db io.directories io.files.temp
continuations site-watcher.db.private db.sqlite continuations db.sqlite
sequences tools.test ; sequences tools.test ;
IN: site-watcher.tests IN: site-watcher.tests