View script | License | Download script | History | Other scripts by: piotrgapinsk |
7-Sep 23:38 UTC
[0.054] 17.815k
[0.054] 17.815k
Archive version of: fileserver.r ... version: 1 ... piotrgapinsk 6-Jul-2005Amendment note: new script || Publicly available? Yes REBOL [ Title: "fileserver" Purpose: "fileserver serving files from the current directory" Comment: { server will listen on port 8080 and generate index.html files on-the-fly files with unrecognized types will be sent as "text/plain" filenames with spaces and/or national chars are handled as well } Date: Version: 2005-07-06 Author: "Piotr Gapinski" Email: {news [at] rowery! olsztyn.pl} File: %fileserver.r Copyright: "Olsztynska Strona Rowerowa http://www.rowery.olsztyn.pl" License: "GNU General Public License (Version II)" Library: [ level: 'intermediate platform: 'all type: [tool] domain: [web tcp other-net] tested-under: [ view 1.3.1 on [winxp] view 1.3.0 on [winxp] ] support: none license: 'GPL ] ] fileserver-ctx: context [ web-dir: what-dir recursive: true set 'server-port 8080 index-file: %index.html log-file: %fileserver.log page-encoding: "iso-8859-2" web: compose [ net allow shell throw file throw (web-dir) [allow read allow write] (index-file) [allow read allow write] (log-file) [allow write] ] secure :web to-dir: func [d] [to-file dirize d] deny-dir?: func [d] [either recursive [false] [all [dir? d web-dir <> (to-dir d)]]] deny-file?: func [f] [found? find [%.log %.r] (suffix? to-file f)] deny-ip?: func [d ip] [false] mime-type?: func [f /local mime-map] [ mime-map: [ %.html "text/html" %.htm "text/html" %.png "image/png" %.jpg "image/jpeg" %.gif "image/gif" %.txt "text/plain" %.lha "application/octet-stream" %.mp3 "audio/mp3" %.rar "application/x-rar-compressed" %.rtf "application/rtf" %.zip "application/x-zip-compressed" %.r "text/plain" ] any [ select mime-map attempt [suffix? to-file f] "text/plain" ] ] set 'server-url does [ to-url any [ attempt [rejoin [{http://} (read join dns:// read dns://) ":" server-port]] join "http://127.0.0.1:" server-port ] ] set 'server-home does [web-dir] emit-log: func [b] [ if block? b [b: reduce b] attempt [write/append/lines log-file rejoin [now " " form b]] ] file-map: make hash! 20 build-local: func [ph] [ attempt [ if not binary? ph [ph: debase/base ph 16] select file-map ph ] ] build-hash: func [d /local b p h path name] [ d: clean-path to-dir d h: make hash! 20 b: any [ attempt [sort read to-dir d] return h ] foreach i b [ set [path name] split-path p: d/:i any [ deny-file? name name = index-file all [dir? p deny-dir? p] repend h [(checksum/method p 'MD5) p] ] ] file-map: unique/skip (append file-map h) 2 return h ] build-index: func [d /local x] [ encoding: any [ select [3 "windows-1250" 4 "iso-8859-2"] fourth system/version page-encoding ] o: make string! 1000 foreach [h p] (build-hash to-dir d) [ set [path name] split-path p ph: enbase/base h 16 append o build-markup {<li><a href="<% ph %>"><% name %></a></li>^/} ] remove back tail x: form web-dir parse form d [(p: {/}) thru x opt [copy p to end]] return build-markup { <html> <head> <title>FileServer Index :: <% p %></title> <meta http-equiv="Content-Type" content="text/html; charset=<% encoding %>"/> <meta http-equiv="Content-Language" content="pl"/> <meta name="generator" content="REBOL FileServer"/> <meta name="author" content="news [at] rowery! olsztyn.pl"/> <basefont face="tahoma,arial"/> <link rel="shortcut icon" href="http://www.rowery.olsztyn.pl/osrimg/favicon.ico"/> </head> <body> <h2>Contents</h2> <ul> <% trim/tail o %> </ul> <font size="-2"> Any inaccuracies in this index may be explained by the fact that it has been prepared with the help of a computer.<br/> page generated by REBOL filesever :: <% form now %> </font> <script language="JavaScript" type="text/javascript" src="http://www.rowery.olsztyn.pl/lib/clock.js"></script> </body> </html> } ] send-page: func [http-port file dat mime /local response] [ insert dat rejoin [ "HTTP/1.0 200 OK^/Content-type: " mime "^/Content-Disposition: inline; filename=" file "^/^/"] write-io http-port dat length? dat response: 200 ] errors: [ 400 "Forbidden" "No permission to access:" 404 "Not Found" "File was not found:" ] send-error: func [http-port err-num file /local err response] [ if not none? (err: find errors err-num) [ insert http-port join "HTTP/1.0 " [ err-num " " err/2 "^/Content-type: text/html^/^/" <HTML> <TITLE> err/2 </TITLE> "<BODY><H1>SERVER-ERROR</H1><P>REBOL Webserver Error: " err/3 " " file newline <P> </BODY> </HTML> ] ] response: err-num ] buffer: make string! 1024 space: [some " "] chars: complement charset " " set 'serve func [http-port /local t-start path dat mime response uri] [ response: 400 clear buffer t-start: now/precise if none? attempt [ while [not empty? http-request: first http-port] [ repend buffer [http-request newline] ] ][return response] repend buffer ["Address: " http-port/host newline] uri: copy {} net-utils/net-log ["buffer" buffer] any [ attempt [parse/all buffer ["GET" space "/" opt [copy uri some chars] space to end]] return response ] net-utils/net-log ["uri" uri "empty?" empty? trim uri] either empty? trim uri [ uri: enbase/base (checksum/method index-file 'MD5) 16 path: web-dir/:index-file ][ build-hash web-dir path: build-local uri if all [not none? path dir? to-file path] [path: path/:index-file] ] net-utils/net-log ["local-path" form path "empty?" empty? path] net-utils/net-log ["mime-type" mime-type? path] net-utils/net-log ["deny-ip?" http-port/host deny-ip? path http-port/host] net-utils/net-log ["deny-path?" deny-file? path] net-utils/net-log ["response" response] dat: copy #{} mime:"text/plain" response: any [ if none? path [send-error http-port 404 uri] if deny-ip? path http-port/host [send-error http-port 400 http-port/host] if all [dir? path deny-dir? path] [send-error http-port 400 uri] if deny-file? path [send-error http-port 400 uri] if none? attempt [ dat: either equal? index-file (second split-path path) [build-index (first split-path path)] [read/binary path] ][send-error http-port 404 uri] send-page http-port second split-path path dat mime: mime-type? path ] emit-log [ http-port/host uri trim rejoin [{"} (to-local-file form path) {"}] mime response length? dat to-decimal difference now/precise t-start ] response ] ] net-watch: false any [ listen-port: attempt [open/lines join tcp://: server-port] do [ alert "Looks like a Web Server is already running on your computer. Turn it off first, then launch fileserver again." quit ] ] view/new visu: layout/size [] 175x160 visu/pane: layout/tight [ box white 180x45 at 5x10 h1 "Server Running" at 5x60 patr: text 200 "Pages transmitted: 0" at 5x80 text to-string server-url across at 5x110 space 4x2 btn "Browse me!" [browse server-url] btn "Show webdir" [browse server-home] return at 5x140 text "www.rebol.net" blue [browse "http://www.rebol.net"] do [ insert-event-func [ if equal? event/type 'close [attempt [close listen-port] quit] event ] ] ] show visu pages: 0 forever [ patr/text: join "Pages transmitted: " pages show patr http-port: first wait listen-port any [ attempt [serve http-port] do [ alert {We apologize, an unexpected error occurred!} quit ] ] close http-port pages: pages + 1 net-utils/net-log ["pages" pages] ] |