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-namespaces
  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
  32         current-directory get or
  33         <static>
  34             t >>allow-listings
  35         swap [ enable-cgi ] when
  36         main-responder set-global
  37         8080 httpd wait-for-server
  38     ] file-server-logging ;
  39
  40 MAIN: file-server-main