REBOL [
    Title: "Simple client/server file transfer example"
    Purpose: {
        To demonstrate the new async kernel.
    }
    Author: "Gabriele Santilli"
    EMail: giesse@rebol.it
    File: %file-transfer.r
    License: {
Copyright (c) 2003, Gabriele Santilli
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:

* Redistributions of source code must retain the above copyright
  notice, this list of conditions and the following disclaimer. 
  
* Redistributions in binary form must reproduce the above
  copyright notice, this list of conditions and the following
  disclaimer in the documentation and/or other materials provided
  with the distribution. 

* The name of Gabriele Santilli may not be used to endorse or
  promote products derived from this software without specific
  prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.
    }
    Date: 20-Aug-2004
    Version: 1.6.0 ; majorv.minorv.status
                   ; status: 0: unfinished; 1: testing; 2: stable
    History: [
        18-Aug-2004 1.1.0 "History start"
        18-Aug-2004 1.2.0 "async-handler!"
        18-Aug-2004 1.3.0 "Finished coding, now testing."
        18-Aug-2004 1.4.0 "Fixed a few bugs."
        18-Aug-2004 1.5.0 "First working version."
        20-Aug-2004 1.6.0 "Fixed an infinite recursion bug at EOF in the server"
    ]
]

; ALPHA /Core has a bug in the GC with async ports.
recycle/off

async-handler!:
    context [
        ; set to none to avoid debug messages.
        debug: :print
        
        accept:
            func [
                "A new socket connection has been opened, and that the PORT object has been cloned and is ready for I/O"
                port [port!] "New port"
            ] [
                debug "Unhandled ACCEPT event. (New port has been created.)"
            ]
        address:
            func [
                "Address lookup (DNS) has been completed"
                port [port!] "The port that is being opened"
                ip-address [tuple!] "The resolved address"
            ] [
                debug ["Unhandled ADDRESS event. (The host name has been resolved to" ip-address ".)"]
            ]
        close:
            func [
                "The socket connection has been closed"
                port [port!] "The port (still open at our side)"
            ] [
                debug "Unhandled CLOSE event. (The peer has closed the connection.)"
            ]
        error:
            func [
                "A networking error has occurred"
                port [port!]
                error [error!]
            ] [
                debug "Unhandled ERROR event."
                either value? 'form-error [
                    error: form-error/all disarm error
                ] [
                    error: any [
                        attempt [do http://www.colellachiara.com/soft/Libs/utility.r form-error/all disarm error]
                        mold disarm error
                    ]
                ]
                debug error
            ]
        init:
            func [
                "The port object has been fully initialized and is ready to begin operation"
                port [port!] "The port that is being opened (but not open yet!)"
            ] [
                debug "Unhandled INIT event. (Port object ready.)"
            ]
        listen:
            func [
                "A new socket connection is being requested"
                port [port!] "The listen port"
            ] [
                debug "Unhandled LISTEN event. (New connection requested.)"
            ]
        open:
            func [
                "The port has been opened successfully"
                port [port!]
            ] [
                debug "Unhandled OPEN event. (The port has been opened.)"
            ]
        read:
            func [
                "New data has been received in the port's input buffer"
                port [port!]
                bytes [integer!] "Number of bytes currently in the buffer"
            ] [
                debug ["Unhandled READ event. (The buffer now contains" bytes "bytes of data.)"]
            ]
        write:
            func [
                "A write operation has been started"
                port [port!]
                bytes [integer!] "Number of bytes remaining to be transmitted"
            ] [
                debug ["Unhandled WRITE event. (" bytes "bytes still need to be transmitted.)"]
            ]
        write-done:
            func [
                "A write operation has been completed"
                port [port!]
            ] [
                debug "Unhandled WRITE-DONE event. (No more bytes in the buffer to be transferred.)"
            ]
        
        handler:
            func [
                "Generic handler function"
                port [port!] "The port"
                action [word!] "The event"
                arg "The argument for the event"
            ] [
                do get in self action port arg
            ]
    ]

listen-handler:
    make async-handler! [
        listen:
            func [
                "A new socket connection is being requested"
                port [port!] "The listen port"
                /local client
            ] [
                ; new connection received, create a new port and initialize
                ; it with the server handler
                client: first port
                make server-handler [client/state/async-handler: :handler]
            ]
    ]

; change this to tune performance
; larger means more RAM / less CPU used
; smaller means less RAM / more CPU used
; too large or too small will slow down the transfer
chunk-size: 1024 * 1024

server-handler:
    make async-handler! [
        close:
            func [
                "The socket connection has been closed"
                port [port!] "The port (still open at our side)"
            ] [
                debug "Client closed connection."
                system/words/close port
            ]
        error:
            func [
                "A networking error has occurred"
                port [port!]
                error [error!]
            ] [
                debug "Error while communicating with the client."
                either value? 'form-error [
                    error: form-error/all disarm error
                ] [
                    error: any [
                        attempt [do http://www.colellachiara.com/soft/Libs/utility.r form-error/all disarm error]
                        mold disarm error
                    ]
                ]
                debug error
                system/words/close port
            ]
        read:
            func [
                "New data has been received in the port's input buffer"
                port [port!]
                bytes [integer!] "Number of bytes currently in the buffer"
                /local message filename
            ] [
                debug "Received data from the client."
                ; NOTE: this assumes that the request will come as one single packet.
                ; in a real-world application you should never make this assumption
                ; as this is not always true.
                message: to block! copy port
                either parse message [
                    'get set filename file!
                ] [
                    start-transfer port filename
                ] [
                    ; unrecognized request.
                    system/words/close port
                ]
            ]
        write:
            func [
                "A write operation has been started"
                port [port!]
                bytes [integer!] "Number of bytes remaining to be transmitted"
                /local data
            ] [
                debug ["Sending data to the client... (" bytes ")"]
                ; keep the buffer filled up
                if all [bytes < 70000 data: copy/part file-port chunk-size] [
                    debug "Inserting new data in the buffer..."
                    insert port data
                ]
            ]
        write-done:
            func [
                "A write operation has been completed"
                port [port!]
            ] [
                debug "All data sent to the client. Closing connection."
                system/words/close file-port
                system/words/close port
            ]

        file-port: none
        start-transfer:
            func [
                "Init transfer"
                port [port!] "Client port"
                filename [file!]
            ] [
                either all [
                    find available-files filename
                    exists? filename
                ] [
                    file-port: system/words/open/binary/direct/read filename
                    insert port copy/part file-port chunk-size
                ] [
                    ; file is not available, return nothing to the client
                    system/words/close port
                ]
            ]
    ]

serve:
    func [
        "Start serving files"
        file-list [block!] "List of files to serve"
        port-number [integer!] "Port number to listen to"
    ] [
        available-files: file-list
        open/direct/binary/async [scheme: 'tcp port-id: port-number] get in listen-handler 'handler
    ]

client-handler:
    make async-handler! [
        close:
            func [
                "The socket connection has been closed"
                port [port!] "The port (still open at our side)"
            ] [
                debug ["All data received for" filename ". Writing any data still in the buffers."]
                insert file-port buffer
                system/words/close port
            ]
        error:
            func [
                "A networking error has occurred"
                port [port!]
                error [error!]
            ] [
                debug ["Error while communicating with the server. (" filename ")"]
                either value? 'form-error [
                    error: form-error/all disarm error
                ] [
                    error: any [
                        attempt [do http://www.colellachiara.com/soft/Libs/utility.r form-error/all disarm error]
                        mold disarm error
                    ]
                ]
                debug error
                system/words/close port
            ]
        open:
            func [
                "The port has been opened successfully"
                port [port!]
            ] [
                debug ["Requesting transfer of file" filename "."]
                insert port mold/only reduce ['get filename]
            ]
        read:
            func [
                "New data has been received in the port's input buffer"
                port [port!]
                bytes [integer!] "Number of bytes currently in the buffer"
            ] [
                debug ["Received data for" filename ". (" bytes ")"]
                insert tail buffer copy/part port bytes
                if chunk-size <= length? buffer  [
                    debug ["Writing data to disk for" filename "."]
                    insert file-port buffer
                    clear buffer
                ]
            ]

        filename:
        file-port: 
        buffer: none
    ]

start-transfer:
    func [
        "Request a file transfer to a server"
        server-url [url!] "URL of the server"
        file-name [file!] "Name of the file to request"
        dest-port [port!] "Destination port to write data to"
        /local ch
    ] [
        ch: make client-handler [
            filename: file-name
            file-port: dest-port
            buffer: make binary! chunk-size + 2
        ]
        open/direct/binary/async server-url get in ch 'handler
    ]