123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123 |
- #!/usr/bin/env bash
- # -*- wisp -*-
- # A Freenet Client Protocol library for Guile Scheme.
- exec -a "${0}" guile -L $(dirname $(realpath "$0")) --language=wisp -x .w -e '(fcp-example)' -c '' "${@}"
- ; !#
- ;; for emacs (defun test-this-file () (interactive) (save-current-buffer) (async-shell-command (concat (buffer-file-name (current-buffer)) " --test")))
- define-module : fcp-example
- . #:export : main
- import
- only (fcp) message-create message-task message-type message-data message-fields
- . message-client-get message-client-get-realtime message-client-get-bulk
- . message-client-put message-client-put-realtime message-client-put-bulk
- . message-remove-request
- . send-message processor-put! processor-delete!
- . printing-passthrough-processor printing-discarding-processor
- . discarding-processor processor-nodehello-printer
- . processor-datafound-getdata
- . node-ip-set! node-port-set!
- . task-id
- . call-with-fcp-connection with-fcp-connection
- only (ice-9 pretty-print) pretty-print
- only (srfi srfi-1) first second third assoc
- only (srfi srfi-26) cut
- only (srfi srfi-37) option args-fold ;; commandline handling
- only (rnrs bytevectors) string->utf8 utf8->string
- define : request-successful-upload message
- . "When the put succeeds, download the data."
- if : equal? 'PutSuccessful : message-type message
- let : : fields : message-fields message
- when : and=> (assoc 'URI fields) : λ (uri-cel) : equal? key (cdr uri-cel)
- send-message
- message-client-get-realtime get-task key
- . #f
- . message
- define : record-successful-download message
- . "When the download succeeds, display the result"
- if : equal? 'AllData : message-type message
- let : : task : message-task message
- when : equal? task get-task
- format #t "Received Message: ~a\n" : utf8->string (message-data message)
- set! successful #t
- . #f
- . message
- define : remove-successful-tasks-from-queue message
- . "Cleanup the task because we use the global queue for easier debugging"
- when : member (message-type message) '(AllData PutSuccessful)
- send-message : message-remove-request : message-task message
- . message
- define put-task : task-id
- define get-task : task-id
- define key : string-append "KSK@" put-task
- define successful #f
- define : setup-handlers
- ;; standard processors
- processor-put! printing-discarding-processor
- processor-put! processor-nodehello-printer
- ;; immediately request data from successfull get requests
- processor-put! processor-datafound-getdata
- ;; custom processors
- processor-put! request-successful-upload
- processor-put! record-successful-download
- processor-put! remove-successful-tasks-from-queue
- ;; commandline handling via srfi-37
- define options
- list
- option '(#\V "version") #f #f
- λ (opt name args loads)
- display "Guile FCP version 0.2\n"
- quit
- option '(#\h "help") #f #f
- λ (opt name args loads)
- format #t "Usage: ~a [options]
- Options:
- -h --help show this dialog
- -V --version show the version
- -H IP_OR_HOSTNAME --host=IP_OR_HOSTNAME set the node address
- -P PORT --port=PORT set the FCP port
- " : car : program-arguments
- quit
- option '(#\P "port") #t #f
- λ (opt name arg loads)
- node-port-set! arg
- . loads
- option '(#\H "host") #t #f
- λ (opt name arg loads)
- node-ip-set! arg
- . loads
- define : main args
- define arguments
- args-fold : cdr args
- . options
- lambda : opt name arg loads
- error "Unrecognized option `~A'" name
- lambda (op loads) : cons op loads
- . '()
- setup-handlers
- ;; open the FCP connection. Anything inside this scope can
- ;; communicate directly with Freenet via FCP, other interaction
- ;; must be done through processing procedures as setup above.
- with-fcp-connection
- ;; get the ball rolling
- send-message
- message-client-put-realtime put-task key
- string->utf8 : string-append "Hello " key
- while : not successful
- display "."
- sleep 1
|