REBOL [ Title: "Remote file Utility" Date: 2001-12-01 Purpose: "Exchange files over a network without ftp" File: %remote-file.r Author: "Ingo Hohmann" Version: 0.0.2 Web: http://www.h-o-h.org Category: [ Network Ftp ] ToDo: [ {error handling} ] Usage: { As a script: remote-file.r receive starts the server that listens for files to be sent remote-file.r send a_file_name sends the file a_file_name As a library do-receive - starts the file recieve server do-receive/file filename - receives exactly one file, and stores under filename do-send afile - sends one file do-send ablock-of-files - sends all files named in the block setup - asks the user for host/port do-setp host port - sets host to host, and port to port } known-bugs: [ {Missing error handling in the server part.} ] library: [ level: 'intermediate platform: 'all type: [tool module] domain: [ftp files other-net] tested-under: [core-2.5.6.4.2] support: none license: none see-also: none ] ] ; helpers din-date: func [ "Shows date in DIN format (iho)" /convert date [date! string!] /local pad ][ pad: func [d] [either 2 = length? d: to-string d [d] [join "0" d]] date: either none? date [now/date] [to-date date] rejoin ["" date/year "-" pad date/month "-" pad date/day] ] error: func [ {Throws a custom error} info [block!] ] [ throw make error! append copy [ h-o-h ] compose info ] on-error: func [ {tries value, and if it returns an error, error-block is done. In the error block 'err contains the disarmed error.} value error-block /local err ][ either error? set/any 'err try :value [ err: disarm err do bind error-block 'err ][ err ] ] system/error: make system/error [ h-o-h: make object! [ code: 1000 type: "h-o-h Script errors" read: ["Unable to read from:" :arg1] write: ["Unable to write to:" :arg1] network: ["Unable to connect to:" :arg1] type-check: ["Expected value of type" :arg1 "but recieved" :arg2 "(" :arg3 ")"] ] ] ; -------------- remote file remote-file: make object! [ header: context [ Title: "H-O-H Remote File" Author: "Ingo Hohmann" Email: %ingo--h-o-h--org Purpose: "Exchange files over a network, without the need for ftp" Version: 0.1 ] my-host: "localhost" my-port: 4321 init?: false setup: func [ "Ask for host and port" /local host port ][ print "Please tell me about the host you want to connect to:" host: ask join "Hostname or IP (" [ my-host "): " ] port: load ask join "Port (" [ my-port "): " ] host: either "" = host [ my-host ][ host ] port: either [] = port [ my-port ][ port ] do-setup host port ] do-setup: func [ "Setup host and port" host [string! tuple!] port [integer!] ][ my-host: host my-port: port ] setup?: func [ "Test if host and port are set" /interactive "Ask if not set" ][ if all [ not none? host not none? port ][ return true ] either interactive [ setup return true ][ return false ] ] ; ; Send ; send: func [ "Send files interactively" /local file err ][ file: ask "Filename: " while [file <> "" ] [ if #"%" = first file [ remove/part file 1 ] file: to-file file if error? err: try [ do-send file ] [ print "Sorry, I was unable to send the file" ] file: ask "Filename: " ] ] do-send: func [ [catch] "Do the send" file [file! block!] /local data port ][ if not block? file [ file: reduce [file] ] foreach f file [ if not file? f [error [type-check (file!) (type? f) (f)] ] ] foreach f file [ if error? data: try [ read/binary f ] [ error compose [ read (f) ] ] if error? try [ port: open/binary join tcp:// [my-host ":" my-port] insert port join f cr insert port data close port ] [ error [ network (join tcp:// [my-host ":" my-port]) ] ] ] ] ; ; Receive ; do-receive: func [ "Receive and save files" /file "Receive only one file" fn [file!] /local pos data filename port connection pass fname fext err ][ if error? err: try [ port: open/binary join tcp://: my-port ] [ error [network join tcp://: my-port ] ] while [true] [ either port = wait [port 1] [ connection: first port data: copy "" ; read the first line of data from the port, ; this line contains the filename until [ append data copy connection all [ 0 < length? data pos: find data cr ] ] ; get the filename filename: last split-path to-file copy/part data pos ;remove the first line from data recieved do far remove/part data next pos prin [ "Receiving" filename ] ; if a file of that name already exists, create a new file name if exists? filename [ if pos: find/last filename "." [ fname: copy/part filename pos fext: copy pos ] pass: 0 while [ pass: pass + 1 exists? filename ][ switch/default pass [ 1 [ filename: join fname [ "-" din-date fext ] ] 2 [ filename: join fname [ "-" din-date "_" replace/all form now/time ":" "." fext]] ] [ filename: join fname [ "-" din-date "_" replace/all form now/time/precise ":" "." fext] ] ] ] prin [ ", saving as:" filename "... " ] ; write the data to the file, until all data has been recieved write/binary filename data while [data: copy connection] [ write/append/binary filename data ] close connection print "done" ; if only recieving one file, stop now if file [ close port return ] ][ ; if keyboard pressed, return if input? [ close port return ] ] ] ] receive: :do-receive ; if started with args, just start args: none if args: system/options/args [ print [ self/header/Title "V." self/header/version ] change-dir system/options/path either #"r" = first first args [ print rejoin [ "Waiting for files on: tcp://" read dns:// ":" my-port newline "Press any key to stop" newline ] do-receive ][ setup either 1 < length? args [ do-send to-file first next args ][ send ] ] ] ] ; remote-file