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

More fixes

db4
Slava Pestov 2008-05-27 02:42:13 -05:00
parent 6edcd94b62
commit fa3ab3a8b8
2 changed files with 15 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
extra/http/server/auth/login/login.factor
View File

@ -64,8 +64,8 @@ M: user-saver dispose
3append <chloe> ; 3append <chloe> ;
! ! ! Login ! ! ! Login
: successful-login ( user -- ) : successful-login ( user -- response )
username>> set-uid ; username>> set-uid "$login" end-flow ;
: login-failed ( -- * ) : login-failed ( -- * )
"invalid username or password" validation-error "invalid username or password" validation-error
@ -84,9 +84,7 @@ M: user-saver dispose
"password" value "password" value
"username" value check-login "username" value check-login
[ successful-login ] [ login-failed ] if* [ successful-login ] [ login-failed ] if*
] >>validate ] >>submit ;
[ "$login" end-flow ] >>submit ;
! ! ! New user registration ! ! ! New user registration

26
extra/http/server/static/static.factor
View File

@ -1,10 +1,10 @@
! Copyright (C) 2004, 2008 Slava Pestov. ! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: calendar html io io.files kernel math math.order USING: calendar io io.files kernel math math.order
math.parser http http.server namespaces parser sequences strings math.parser http http.server namespaces parser sequences strings
assocs hashtables debugger http.mime sorting html.elements assocs hashtables debugger http.mime sorting html.elements
html.templates.fhtml logging calendar.format accessors html.templates.fhtml logging calendar.format accessors
io.encodings.binary fry ; io.encodings.binary fry xml.entities ;
IN: http.server.static IN: http.server.static
! special maps mime types to quots with effect ( path -- ) ! special maps mime types to quots with effect ( path -- )
@ -58,20 +58,18 @@ TUPLE: file-responder root hook special allow-listings ;
: file. ( name dirp -- ) : file. ( name dirp -- )
[ "/" append ] when [ "/" append ] when
dup <a =href a> write </a> ; dup <a =href a> escape-string write </a> ;
: directory. ( path -- ) : directory. ( path -- )
[ dup file-name [
dup file-name [ [ <h1> file-name escape-string write </h1> ]
[ <h1> file-name write </h1> ] [
[ <ul>
<ul> directory sort-keys
directory sort-keys [ <li> file. </li> ] assoc-each
[ <li> file. </li> ] assoc-each </ul>
</ul> ] bi
] bi ] simple-page ;
] simple-page
] with-html-stream ;
: list-directory ( directory -- response ) : list-directory ( directory -- response )
file-responder get allow-listings>> [ file-responder get allow-listings>> [