fcp-example.w

@@ -0,0 +1,111 @@
+#!/usr/bin/env bash
+# -*- wisp -*-
+# A Freenet Client Protocol library for Guile Scheme.
+
+guile -L $(dirname $(realpath "$0")) -c '(import (language wisp spec))'
+PROG="$0"
+if [[ "$1" == "-i" ]]; then
+    shift
+    exec -a "${PROG}" guile -L $(dirname $(realpath "$0")) --language=wisp -x .w -e '(fcp-example)' -- "${@}"
+else
+    exec -a "${0}" guile -L $(dirname $(realpath "$0")) --language=wisp -x .w -e '(fcp-example)' -c '' "${@}"
+fi;
+; !#
+
+;; 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
+
+define version "0.0.0 just-do-it"
+
+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 
+             . task-id
+             . call-with-fcp-connection with-fcp-connection
+    only (ice-9 pretty-print) pretty-print truncated-print
+    only (ice-9 iconv) string->bytevector
+    only (srfi srfi-1) first second third alist-cons assoc lset<= lset-intersection lset-difference take
+    only (rnrs bytevectors) make-bytevector bytevector-length string->utf8 utf8->string bytevector?
+    only (rnrs io ports) get-bytevector-all get-bytevector-n
+         . put-bytevector bytevector->string port-eof?
+    only (ice-9 popen) open-output-pipe
+    only (ice-9 regex) string-match match:substring
+    doctests
+
+define : help args
+    format : current-output-port
+           . "~a [-i] [--help | --version | --test | YYYY-mm-dd]
+
+Options:
+        -i    load the script and run an interactive REPL."
+           first args
+
+define : final-action? args
+   if {(length args) <= 1} #f
+     cond 
+       : equal? "--help" : second args
+         help args
+         . #t
+       : equal? "--version" : second args
+         format : current-output-port
+                . "~a\n" version
+         . #t
+       else #f
+       
+    
+define : main args
+  define put-task : task-id
+  define get-task : task-id
+  define key : string-append "KSK@" put-task
+  define successful #f
+  define : request-successful-upload message
+    cond
+        : equal? 'PutSuccessful : message-type message
+          let : : fields : message-fields message
+              when : and=> (assoc 'URI fields) : λ (uri) : equal? key : cdr uri
+                  pretty-print message
+                  send-message
+                      message-client-get-realtime get-task key
+                  send-message
+                      message-remove-request : message-task message
+              . #f
+        else message
+  define : record-successful-download message
+    cond
+        : equal? 'AllData : message-type message
+          let : : task : message-task message
+              when : equal? task get-task
+                  pretty-print message
+                  display "Data: "
+                  truncated-print : utf8->string (message-data message)
+                  newline
+                  set! successful #t
+                  send-message
+                      message-remove-request task
+              . #f
+        else message
+  ;; standard processorrs
+  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
+  when : not : final-action? args
+    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 10

fcp.w

@@ -15,7 +15,18 @@ fi;
 ;; for emacs (defun test-this-file () (interactive) (save-current-buffer) (async-shell-command (concat (buffer-file-name (current-buffer)) " --test")))
 
 define-module : fcp
-    . #:export : main
+    . #:export
+    main 
+      . 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 
+      . task-id
+      . call-with-fcp-connection with-fcp-connection
 
 define version "0.0.0 just-do-it"
 

fetchpull.w

@@ -42,6 +42,7 @@ import
     only (ice-9 pretty-print) pretty-print
     only (ice-9 rdelim) read-line read-delimited
     only (ice-9 format) format
+    only (ice-9 iconv) string->bytevector
     only (srfi srfi-1) first second third alist-cons assoc lset<= lset-intersection lset-difference
     only (rnrs bytevectors) make-bytevector bytevector-length string->utf8 bytevector?
     only (rnrs io ports) get-bytevector-all get-bytevector-n