]> gitweb.factorcode.org Git - factor.git/blob - extra/file-server/file-server.factor
Fixes #2966
[factor.git] / extra / file-server / file-server.factor
1 ! Copyright (C) 2015 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
3
4 USING: accessors command-line concurrency.messaging http.server
5 http.server.cgi http.server.static io io.pathnames io.servers
6 kernel logging.server namespaces sequences threads ;
7
8 IN: file-server
9
10 : file-server-logging ( quot -- )
11     [
12         init-namestack
13         receive
14
15         dup first "log-message" = [
16             dup last "http.server" = [
17                 dup rest first3 write-message flush
18             ] when
19         ] when
20
21         "log-server" get-global send t
22     ] "Log server (file-server)" spawn-server "log-server" [
23         call
24     ] with-variable ; inline
25
26 : file-server-args ( command-line -- cgi? path/f )
27     "--cgi" swap [ member? ] [ remove ?first ] 2bi ;
28
29 : file-server-main ( -- )
30     [
31         command-line get file-server-args "." or
32         <static>
33             t >>allow-listings
34         swap [ enable-cgi ] when
35         main-responder set-global
36         8080 httpd wait-for-server
37     ] file-server-logging ;
38
39 MAIN: file-server-main