Wednesday, 31 October 2012

File server

You can share your files over your LAN using the following script.
Put the script in the directory you want to share and start it.
Every PC on the your LAN can browse and read or download files shared on you public ip on the 8080 port using a browser like Firefox or Chrome or IE (with every browser works!).
Using a browser you'll obtain this:
Here the source that I slightly  modified: (and translated comments from Polish)
    Title: "Obscure File Server"
    Purpose: "Share files over HTTP protocol +NLS"
    Author: "pijoter" ;+ Massimiliano Vessi
    Date: 2-Sep-2009/21:04:51+2:00
    File: %fileserver.r
    Log: %fileserver.log
    License: "GNU General Public License (Version II)"
    Library: [
        level: 'intermediate
        platform: 'all
        type: [tool]
        domain: [file-handling web tcp other-net]
        tested-under: [
            view 2.7.6   on [Linux WinXP]
        support: none
        license: 'GPL
    Tabs: 3
    version: 2.0.0
dt: context [
    to-human: func [dt [date!] /date /time /local pad d t s] [
        pad: func [val n] [head insert/dup val: form val #"0" (n - length? val)]
        dt: rejoin [
            (pad dt/year 4) #"-" (pad dt/month 2) #"-" (pad dt/day 2)
            #"/" to-itime any [dt/time 0:00]
        any [
            if date [copy/part dt 10]
            if time [copy/part (skip dt 11) 8]
    to-stamp: func [dt [date!] /date] [
        dt: any [
            if date [self/to-human/date dt]
            self/to-human dt
        remove-each ch dt [found? find "-/:" ch]
    to-gmt: func [date [date!]] [
        any [
            zero? date/zone
            attempt [
                date: date - date/zone
                date/zone: 0:00
log: context [
    FILE: any [attempt [system/script/header/log] %fileserver.log]
    emit: func [info] [
        if block? info [info: reduce info]
        attempt [write/append/lines self/FILE reform [(dt/to-stamp now) (form info)]]
fs: context [
    DENY-DOT: true
    DENY-DIR: [
        ;; directory systems SCM
        %.git/ %.cvs/ %.svn/
    DENY-FILE: reduce [
        ;; file server and logs
        any [attempt [system/script/header/file] %fileserver.r]
        any [attempt [system/script/header/log] log/FILE]
    SORT-METHOD: 'name ;; 'date 'name 'size

    paths: make hash! 256
    deny-file?: func [file [file!] /local rc] [
        rc: any [
            found? find self/DENY-FILE file
            if self/DENY-DOT [self/is-dot? file]
        net-utils/net-log ["fs/deny-file?" file "deny?" (to-logic rc)]
        return rc
    deny-dir?: func [dir [file!] /local rc] [
        rc: any [
            found? find self/DENY-DIR dir
            if self/DENY-DOT [self/is-dot? dir]
        net-utils/net-log ["fs/deny-dir?" (dir) "deny?" (to-logic rc)]
        return rc
    deny-subdir?: :deny-dir?
    to-dir: func [target [string! file!]] [dirize to-file target]
    is-dir?: func [target [string! file!]] [#"/" = last target]
    is-file?: func [target [string! file!]] [not self/is-dir? target]
    is-dot?: func [target [string! file!]] [#"." = first target]
    make-id: func [path [string! file!]] [enbase/base (checksum/method (form path) 'MD5) 16]
    is-id?: func [id [string!]] [equal? 32 (length? id)]
    update-paths: func [dir [string! file!]
        /local hash dir-content bag item info dirs files path] [
        dir: clean-path (self/to-dir dir)
        hash: make hash! 64
        any [
            dir-content: attempt [sort read dir]
            return hash ;;blank map files
        if found? find [date size] self/SORT-METHOD [
            attempt [
                bag: make block! (2 * length? dir-content)
                foreach item dir-content [
                    info: info? dir/:item
                    repend bag [(get in info self/SORT-METHOD) item]
                sort/skip/reverse bag 2
                clear dir-content
                foreach [value item] bag [append dir-content item]
                unset 'bag
        ;; sort files and directories separately
        dirs: remove-each target (copy dir-content) [
            any [
                self/is-file? target
                self/deny-dir? target
        files: remove-each target dir-content [
            any [
                self/is-dir? target
                self/deny-file? target
        foreach item (union dirs files) [
            path: dir/:item
            repend hash [(self/make-id path) path]
            ;; net-utils/net-log ["fs/update-paths" "item" (item) "is-dir?" (is-dir? target)]
        ;; TODO: do not modify the list of global catalog for each overcharge
        self/paths: union/skip self/paths hash 2
        return hash
    local-path: func [id [string! none!]] [select self/paths id]
    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"   "application/x-zip-compressed"
        %.r     "text/plain"
        %.reb   "text/plain"   "text/plain"
        %.php   "text/plain"   "text/plain"
        %.jsp   "text/plain"
        %.js   "text/plain"
        %.css   "text/plain"
    mime?: func [path [string! file!]] [
        any [
            attempt [select self/mime-map (suffix? to-file path)]
net: context [
    DENY-IP: []
    ;; DENY-IP: []
    ALLOW-IP: [;; trusted hosts ]

    SERVER-PORT: 8080
    BUFFER-SIZE: 1024 * 1024 * 1 ; 1M

    mime: none
    status: none
    response: [
        200 "OK" "Everything is just fine"
        400 "Bad Request" "Malformed request:"
        401 "Unauthorized" "No permission to access:"
        403 "Forbidden" "No permission to access:"
        404 "Not Found" "Resource was not found:"
        410 "Gone" "Resource is no longer available:"
    server-ip: has [ip port interfaces ifc] [
        ip: make block! 5
        append ip []
        attempt [
            port: open tcp://
            interfaces: get-modes port 'interfaces
            foreach ifc interfaces [append ip get in ifc 'addr]
            close port
        if not empty? self/DENY-IP [self/ALLOW-IP: union self/ALLOW-IP ip]
        sort unique ip
    server-url: does [rejoin [http:// (first self/server-ip) ":" (self/SERVER-PORT)]]
    server-dir: does [what-dir]
    server-path: func [path [file!]] [find/tail (form path) (head remove back tail (form self/server-dir))]
    url?: func [port [port!]] [rejoin ["http://" (port/local-ip) ":" (port/local-port)]]
    deny-ip?: func [ip] [
        if any [
                empty? self/DENY-IP
                found? find self/ALLOW-IP ip
            ] [return false]
        to-logic any [
            found? find self/DENY-IP ip
            found? find self/DENY-IP
            found? find self/DENY-IP 'all
    send-header: func [port [port!] mime [string!]
        /with custom-header [string!]
        /error err-num [integer!]
        /local header status] [
        attempt [
            self/status: status: any [(if error [err-num]) 200]
            self/mime: mime
            header: rejoin [
                    "HTTP/1.1 " (status) " " (select self/response status) CRLF
                    "Content-Type: " (mime) "; charset=" (content/encoding) CRLF
                    "Content-Language: " (content/language) CRLF
                    "Expires: " (to-idate now) CRLF
                    "Date: " (to-idate now) CRLF
                    "Connection: close" CRLF
            if with [append header custom-header]
            append header CRLF
            net-utils/net-log ["net/send-header" "size" (length? header) "header" (header)]
            write-io port header (length? header)
    send-page: func [port [port!] buffer [string! binary!]
        /error err-num [integer!]
        /local mime] [
        mime: "text/html"
        all [
            any [
                if error [self/send-header/error port mime err-num]
                self/send-header port mime
            write-io port buffer (length? buffer)
    send-error: func [port [port!] err-num [integer!] message [string! binary!]
        /local err body] [
        err: any [
            attempt [find self/response err-num]
        body: rejoin [""
            <html> LF
            <head> LF
                <title> (second err) </title> LF
                <basefont face="tahoma,arial"/> LF
            </head> LF
                <h2> "SERVER-ERROR" </h2> LF
                <p> (third err) "&nbsp;" (to-string message) <br/> (to-idate now) </p> LF
        self/send-page/error port body err-num
    send-file: func [port [port!] path [string! file!]
        /local dir file mime size disposition fh buffer part bytes] [
        set [dir file] split-path path
        size: size? path
        mime: fs/mime? file
        disposition: rejoin [
            "Content-Disposition: inline; filename=" {"} (form file) {"; size="} (size) {"} CRLF
            "Content-Length: " (size) CRLF
        net-utils/net-log ["net/send-file" (path) "size" (size) "mime" (mime)]
        all [
            self/send-header/with port mime disposition
            attempt [
                fh: open/binary/direct/read path
                buffer: make binary! self/BUFFER-SIZE
                part: 0
                forever [
                    bytes: read-io fh buffer self/BUFFER-SIZE
                    if zero? bytes [break]
                    part: part + 1
                    net-utils/net-log ["net/send-file" (file) "part" (part) "bytes" (bytes)]
                    write-io port buffer bytes
                    clear buffer
                close fh
                unset 'buffer
    get-id: func [port [port!]
        /local buffer space chars resource valid?] [
        buffer: copy port
        space: [some { }]
        chars: complement charset { }
        resource: make string! 40
        valid?: to-logic all [
            parse/all buffer ["GET" space "/" [opt [copy resource some chars]] space "HTTP" to end]
            not empty? resource
        net-utils/net-log ["net/get-id" "id" (resource) "valid?" (valid?) "buffer" (to-string buffer)]
        if valid? [resource]
content: context [
    language: "pl,en"
    encoding: any [
        select [3 "windows-1250" 4 "utf-8"] fourth system/version
    make-index: func [dir [string! file!]
        /local output prev-path prev-dir id path target item f l s] [
        output: make string! 1024
        ;; View "parent-dir" only when we are not in the main directory
        if not equal? dir net/server-dir [
            set [prev-path prev-dir] (split-path dir)
            id: fs/make-id prev-path
            append output rejoin [{<li><a href="} (id) {">..</a> :: (<a href="} (id) {">parent dir</a>)</li>} LF]
        foreach [id path] (fs/update-paths dir) [
            target: second (split-path path)
            item: any [
                attempt [
                    f: info? path
                    ;;File size in human format
                    l: length? (to-string f/size)
                    s: any [
                        if l <   4 [join form f/size "B"]
                        if l <   7 [join form (round/to (f/size / 1024) 0.01) "K"]
                        if l < 10 [join form (round/to (f/size / 1048576) 0.01) "M"]
                        join form (round/to (f/size / 1073741824) 0.01) "G"
                    select [
                        file [{<li><a href="} (id) {">} (target) {</a> :: } (s) {</li>} LF]
                        directory [{<li><a href="} (id) {">} (target) {</a> :: (dir)</li>} LF]
                    ] f/type
                [{<li><a href="} (id) {">} (target) {</a></li>} LF]
            append output (rejoin item)
        path: net/server-path dir
        rejoin [""
            <html> LF
            <head> LF
                <title> "FileServer" </title> LF
                {<meta http-equiv="Content-Type" content="text/html; charset=} (self/encoding) {"/>} LF
                {<meta http-equiv="Content-Language" content="} (self/language) {"/>} LF
                {<meta name="generator" content="} (system/script/header/title) {"/>} LF
                {<meta name="author" content="} (system/script/header/author) {"/>} LF
                <basefont face="tahoma,arial"/> LF
            </head> LF
            <body> LF
                <h2> {Index :: } (path) </h2> LF
                <ul> LF (trim output) </ul> LF
                <font size="-2"> LF
                {Any inaccuracies in this index may be explained by the fact that it has been prepared with the help of a computer.} <br/> LF
                {Page generated by <a href="">REBOL FileServer</a> :: }
                (form to-idate now) LF
                </font> LF
            </body> LF
            </html> LF
    handle: func [port [port!]
        /local start id resource-id path resource-path dir target bytes err-num stop t] [
        start: now/precise
        ;;retrieve the local path on the basis of ID from the URI
        ;; if ID exists but does not match the file (no entry in fs / paths or the file is missing) to generate a 404 error    
        any [
            if id: net/get-id port [path: any [(fs/local-path id) (net/server-dir)]]
            id: fs/make-id (path: net/server-dir)
        either (id = fs/make-id path) [
            ;; keep copies of the access path to the file and the generated id
            ;; the original may be modified by append file name
            resource-path: path
            resource-id: id
            if dir? path [
                ;; index file for the virtual directories containing
                ;; created a list of content (subdirectories and files)
                path: rejoin [path "index.html"]
                id: fs/make-id path
            set [dir target] (split-path path)
            bytes: any [
                ;; check access restrictions
                if (net/deny-ip? port/host) [net/send-error port 401 (net/url? port)]
                if (fs/deny-subdir? (second split-path dir)) [net/send-error port 410 resource-id]
                if (fs/deny-file? target) [net/send-error port 410 resource-id]
                ;;generate index only when the original path does not include the file name (appended "index.html")
                if all [(fs/is-dir? resource-path) (equal? (form target) "index.html")] [net/send-page port (self/make-index dir)]
                ;; if possible send a file
                if not exists? path [net/send-error port 404 resource-id]
                net/send-file port path
            if zero? bytes [bytes: self/send-error port 404 resource-id]
            ;;if you can not assign the path to the CRC (because there is no entry in fs / file-map or no CRC) Use an empty string. In the absence of CRC checksum will be generated for resource-path variable

            resource-path: {}
            resource-id: any [id (fs/make-id resource-path)]
            err-num: any [if (fs/is-id? resource-id) [404] 400]
            bytes: net/send-error port err-num resource-id
        stop: now/precise
        ;; log position relative to the shared folder
        resource-path: any [
            if all [resource-path (not empty? resource-path)] [net/server-path resource-path]
        log/emit [
            rejoin [{"} resource-path {"}]
            t: to-decimal (difference stop start)
        net-utils/net-log ["content/handle" "bytes" (bytes) "time" t "speed" (round/to (bytes / t) / 1024 0.01) "KB/sec"]

net-watch: false
system/options/quiet: true
my-name: read dns://
my-ip: read join dns:// my-name
either view? [
    ;; rebol/view
    view/new gui: layout [      
        h1   "Server Running"
        text "Your PC name is:"
        text bold   my-name
        text"Your public IP to share is:"
        text bold (rejoin ["http://" my-ip ":8080"])
        ;text to-string net/server-url
        patr: text 200 "Pages transmitted: 0"
        bytr: text 200 "Bytes transmitted: 0.0M"        
        btn "Browse server" [browse net/server-url]
        btn "Show directory" [browse net/server-dir] return
        do [
            insert-event-func [
                if equal? event/type 'close [attempt [(close client) (close server)] quit]
    show gui
    ;; rebol/core
    unprotect 'alert
    alert: func [message] [print message ask "press-enter^/"]
    any [
        foreach ip net/server-ip [print rejoin [{Server URL: } "http://" ip ":" net/SERVER-PORT]]
any [
    server: attempt [open/binary/direct/no-wait rejoin [tcp://: net/SERVER-PORT]]
    do [
        message: rejoin [
            {Looks like a Web Server is already running on your computer (port } net/SERVER-PORT {).}
            {Turn it off first, then try again.}
        alert message
pages: 0
bytes: 0.0
forever [
    wait server
    wait client: first server
    if error? err: try [size: content/handle client] [
        print disarm err
        alert "an unexpected error occurred!"
    if view? [
        pages: pages + 1
        bytes: bytes + size
        patr/text: join "Pages transmitted: " pages
        bytr/text: rejoin ["Bytes transmitted: " round/to (bytes / 1048576) 0.01 "M"]
        show [patr bytr]
    close client

It generates also a file log called fileserver.log. You can use this script also with Rebol/Core (no graphic).

Friday, 26 October 2012


VID dialect has a "strange" component: LIST.
This component is very useful, but you have to know what it means.
LIST try to fill vertically the given area using the layout you give and supply block, for example:
view layout [list 300x300 [space 0x0 across button red button gold button forest ] supply [face/text: reform [count "x" index ] ] ]

will produce this:

As you noticed, LIST uses two variables: count and index.
COUNT is the variable index to every layout line, INDEX is the variable index for every face in the current layout.
LIST permit you to create funny multi column lists, here an example:

Here the source:
Rebol []
files: sort read %.
list-files: copy []
foreach item files [append/only list-files reduce [
        size? item
        modified? item      
n:   0 ;scroller starter for list
view layout [
    backdrop effect [gradient 1x1 0.0.20 0.30.120]
    text as-is white bold join "Path:   " what-dir    
    vx: list 320x400 240.240.240 [
        across space 0x0
        txt bold 100 [print face/text]
        txt 80 180.0.0 right
        txt 75 right        
        ] supply [
            count: count + n ; n is the amount of scrolling for data
            either count <= length? files [ face/text:   list-files/:count/:index ] [face/text: ""]          
        scroller 16x400 [
            n:   to-integer (face/data * (length? list-files) )          
            show vx

BEWARE: every time something happen to the LIST (mouse over LIST, click, anything), LIST will redraw the all the face and your data (and index data) must be in the correct position, otherwise you could obtain a lot of "none" on the screen.
To scroll a LIST you have just to change the starting count, you don't need to use other functions.
You can use LIST also when you don't know the number of faces (buttons, fields, etc.) you'll need, or to create "dynamic" layouts.

Thursday, 25 October 2012


FastCGI is a new CGI protocol that replace and improve CGI in webservers (Apache, ISS, Lighttpd), and rebol can use it!
FastCGI is especially focused for high value application: greater scurity, distributed computing and extensible
You can  read more information here:
The FastCGI is one of the reserved features in commercial Rebol:
If you need this feature just go to the and buy one of them.

Wednesday, 24 October 2012

Contact Carl

There is a script on to contact Carl, you could just send an email to or to, but doing it with rebol is cooler!
Why don't you contact Carl asking for Rebol Open source?
Come on!
This is the code:
    Title: "Feedback"
    Date: 2-Apr-2001
    Version: 1.0.0
    File: %feedback.r
    Author: "Carl Sassenrath"
    Purpose: "Sends feedback to REBOL Technologies."
    library: [
        level: 'intermediate
        platform: none
        type: none
        domain: [email GUI]
        tested-under: none
        support: none
        license: none
        see-also: none
fields: [f-cat f-area f-name f-email f-date f-prod f-vers f-summary f-descrp f-code f-urge]
submit: has [out dt t file] [
    out: copy ""
    foreach f fields [
        repend out [skip form f 2 ": " mold get in get f 'text newline]
    alert either not error? try [send out][
        "Email has been sent to feedback. Thank you."
    ]["Email could not be sent. Check network connection and settings." ]
clear-field: func [f] [clear f/text f/line-list: none f/para/scroll: 0x0]
reset-fields: does [
    clear-field f-summary
    clear-field f-descrp
    clear-field f-code
    f-name/text: user-prefs/name ;system/user/name
    f-email/text: form system/user/email
    f-date/text: form now
    f-vers/text: form system/version
    f-urge/data: head f-urge/data
    f-cat/text: first head f-cat/data
    f-area/text: first head f-area/data
    focus f-summary
lo: layout [
    style tx label 100x24 right
    style fld field 400x24
    across space 4x4
    tx "Categories:" f-cat: choice 196x24 "Bug Report" "Enhancement/Idea" "Comment/Praise" "General Question"
    f-area: choice 196x24 "General" "Core Functions" "View Graphics" "VID" "Application" "Documentation" "Web Site"
    tx "Report From:" f-name: fld 196
    tx "Product:" 74 f-prod: fld 114x24 form system/product
    tx "Email Address:" f-email: fld 196
    tx "Version:" 74 f-vers: fld 114x24 form system/version
    tx "Date/Time:"   f-date: fld 196x24 form now
    tx "Urgency:" 74 f-urge: rotary 114 leaf "Normal" 200.0.0 "Critical" 40.40.180 "Low" 100.100.100 "Reminder"
    tx "Summary:" f-summary: fld return
    tx "Description:" f-descrp: area wrap 400x72 return
    here: at
    tx "Code Example:" f-code: area 400x72 font [name: font-fixed] return
    pad 106
    button "Send" #"^S" [submit]
    pad 90
    button "Clear" [reset-fields show fields]
    button "Close" #"^Q" [unview/only lo]
view center-face lo

Tuesday, 23 October 2012

Fading text

The following code is an example of fading text, push next to see the next effect:

    Title: "Fade Presentation"
    Date: 20-May-2000
    Purpose: "Demonstrate fade effects"
    File: %fadetext.r
    Author: "Jeff"
    library: [
        level: 'advanced
        platform: none
        type: none
        domain: 'GUI
        tested-under: none
        support: none
        license: none
        see-also: none
random/seed now
ptext: parse form next first system/words none
incr: func [/tup /templ /inc] [
    tup: 10.10.10 + random 255.255.255
    tmp: copy []
    inc: reduce [(to-integer tup/1 / 10) (to-integer tup/2 / 10) (to-integer tup/3 / 10)]  
    reduce [tup inc]
one-way: func [c end inc][
    make face/feel [
        engage: func [f a e] compose/deep [
            all [   a = 'time (to-set-path c/1) (c/1) (inc)
                (end) = (c/1) f/rate: 0
                ] show f
set [sc inc] incr
r-vect: does [2x2 - random 3x3]
gm:   does [compose [gradmul (r-vect) (white) (black)]]
bgc: does [one-way [f/color] sc compose [+ (inc)]]
tgc: does [one-way [f/font/color] black compose [- (inc)]]
view layout [
    bg: backdrop 0.0.0 with [rate: 10 feel: bgc effect: gm]
    tt: text (ptext/1) 120x30 (sc) with [font: [size: 18] rate: 10 feel: tgc effect: [key 0.0.0]]
    button "Next" [
        tt/text: first either tail? ptext: next ptext [ptest: head ptext][ptext] bg/effect: gm set [sc inc] incr
        bg/color: black tt/font/color: sc bg/feel: bgc
        tt/rate: bg/rate: 10 show reduce [bg tt]

Monday, 22 October 2012

Making graphs

Rebol is fantastic to render graphs, with one line of code you can create wonderful graphs.
First of all you must know that in all programming languages coordinates on windows are to the right and to the bottom like this:
so we must remind us to flip vertical our graph.
First of all we must have some data to display

my-data: [ 10 20 30 40 50 200 190 220 60 150 ]

then we must give a sequence to these data, making them pair data to plot on the graph:
tempg:   [ 0x0 ]
temp: 0
foreach item my-data [
    temp: temp + 10
    append tempg (as-pair temp item)    

then we can use the grid effect to a 300x300 box. After the grid command you put the distance of the x and y grid and the offset (put always 0x0):

my-data: [10 20   30 40 50 200 190 220 60 150 ]
tempg:   [0x0]
temp: 0
foreach item my-data [
    temp: temp + 10
    append tempg (as-pair temp item)    
lay:   compose/deep [box 300x300 effect [grid 10x10 0x0 draw [pen red   LINE-WIDTH 3   line (tempg) ] flip 0x1   ] ]
view layout [
    title "My graph"
    panel lay ;tricky!!!

You can add any DRAW effect to your graph: arrows, spline or whatever you wish:

If you need more complex graph, you can use the q-plot library; you can download the library from here:
There is a fantastic guide here:
I just upload here some examples:

Friday, 19 October 2012

AltMe on Linux 64bit

I post here a solution for a simple problem: Altme on Linux 64bit seems not working.


Firsto of all, do you know what is AltMe?
AltMe is a free chat software like IRC, but made only in pure Rebol; instead of rooms, there are worlds.
Rebol4 world is very populated of rebol users.
In order to use AltMe, just download it from:

then you must have a free account on it.
In order to have an account there are three ways:

Rebol gateway

This is the recommended method.
REBOL Gateway is an AltME world set up as a gateway to other REBOL resources.
  • Start the AltME client (that you just downloaded)
  • go to:
    • World: REBOL-gate
    • Username: guest
    • Password: guest
  • Post a message in the REBOL4 Join Requests group. We'll need your full name, preferred username, and a working email address (to send you a password)
  • Sit back and wait for a confirming email. To prevent spam, join requests are checked by real humans, so please be patient; it may take us a day or two to respond
  • If you are new to AltME: while you are waiting, please play with making posts in the playpen group. That'll give you a feel for how AltME works
  • Also, ask any questions in the Questions? group

Ask via email

If you are not a member, you can join by sending an email to:
with the word subscribe on the subject line.

Ask via

 Register on and then click on

Linux 64 bit problem

If you use Linux 64bit, you AltMe could give you this error:
./altme: error while loading shared libraries: wrong ELF class: ELFCLASS64
solution is very easy: create a file in the same directory of altme with this content:

It's very important that the last line is the full path to the original altme binary.
Then make executable and launch it:

chmod u+x ./