| 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]
] |