;; Copyright (C) 2022, Matt Welland
;;   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.
;;   Neither the name of the author nor the names of its contributors may 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 HOLDERS 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.


(module imap

	*
;; (insert-file
;;  gen-ssk
;;  retrieve-file
;;  verbosity
;; 
;;  ;; add lower level stuff later
;;  ;;
;;  ;; send-and-print
;;  ;; get-next-message
;;  ;; client-send-hello
;;  ;; wait-for-node-hello
;;  ;; test-dda
;;  ;; with-connection
;;  ;; make-key
;;  )

(import scheme
	(chicken io)
	(chicken tcp)
	(chicken base)
	(chicken file)
	(chicken string)
	(chicken port)
	(chicken pretty-print)
	(chicken process-context posix)
	(chicken time)
	srfi-1
	srfi-18
	srfi-69
	base64
	regex
	matchable
	)
  
(define port (make-parameter 4143))
(define host (make-parameter "localhost")) ;; 127.0.0.1"))
(define verbosity (make-parameter 0))
(define sessionstr (make-parameter "A1"))

;; 2 - debug
;; 1 - normal
;; 0 - quiet, errors only
;;
(define (doprint v . params)
  (if (>= (verbosity) v)
      (with-output-to-port (current-error-port)
	(lambda ()(apply print params)))))

;; send conc of str with \r\n
;;
(define (send-and-print p . str)
  (let* ((basestr (apply conc str))
	 (fullstr (conc basestr "\r\n")))
    (display fullstr p)
    (doprint 2 "Sending: \""basestr"\"")))

(define (get-one-line i)
  (let* ((inl (read-line i)))
    (doprint 2 "Recv: "inl)
    inl))

(define (with-connection proc)
  (let-values (((i o)(tcp-connect (host) (port))))
    (let* ((firststr (let ((l (get-one-line i)))
		       (print l)
		       l))
	   (result   (proc i o)))
      (close-input-port i)
      (close-output-port o)
      result)))

(define (get-input-from-console prompt)
  (print prompt)
  (read-line))

;;======================================================================
;; Operations
;;======================================================================

;; LOGIN
(define (login i o emailadr password)
  (send-and-print o (conc (sessionstr)" login "emailadr" "password))
  (let* ((resp  (get-one-line i))
	 (parts (if (string? resp)
		    (string-split resp)
		    #f)))
    (match parts
      ((sstr "OK" . rem)
       (if (equal? sstr (sessionstr))
	   (begin
	     (doprint 2 "Login sucessful")
	     #t)
	   (begin
	     (doprint 2 "Session string "sstr" didn't match "(sessionstr))
	     #f)))
      (else  (doprint 2 "Login failed, result: "resp) #f)
      )))

;; list emails
(define (list-email i o folder)
  (send-and-print o (conc (sessionstr) " LIST \"INBOX/\" \""folder"\""))
  ;; * LIST (HasNoChildren) "/" INBOX/some_other_folder
  ;; A1 OK List completed (0.000 + 0.000 secs).
  (let loop ((result '()))
    (let* ((inl   (get-one-line i))
	   (parts (string-split inl))) ;; is it needed to check for eof here?
      (match parts
	((sstr "OK" "LIST" "completed" . rem) result)
	((sstr "LIST" . rem)
	 (loop (cons (last rem) result)))
	(else (doprint 0 "ERROR: Unrecognised input \""inl"\"")
	      result)))))

;; select mailbox
;;
;; g21 SELECT "INBOX"
;; * FLAGS (\Answered \Flagged \Deleted \Seen \Draft)
;; * OK [PERMANENTFLAGS (\Answered \Flagged \Deleted \Seen \Draft *)] Flags permitted.
;; * 4 EXISTS
;; * 0 RECENT
;; * OK [UNSEEN 2] First unseen.
;; * OK [UIDVALIDITY 1536750617] UIDs valid
;; * OK [UIDNEXT 9] Predicted next UID
;; * OK [HIGHESTMODSEQ 11] Highest
;; g21 OK [READ-WRITE] Select completed (0.000 + 0.000 secs).
;;
;; returns num unseen
;;
(define (select-folder i o folder)
  (send-and-print o (conc (sessionstr) " SELECT \""folder"\""))
  (let loop ((result #f))
    (let* ((inl   (get-one-line i))
	   (parts (string-split inl))) ;; is it needed to check for eof here?
      (match parts
	((sstr "OK" "[READ-WRITE]" status . rem)
	 (if (member status '("Done" "completed"))
	     result
	     (begin
	       (print "BAD STATUS: "status)
	       result)))
	((sstr quant "EXISTS")
	 (loop (string->number quant)))
	(else (loop result))))))

(define (search i o #!optional (typeflag "ALL"))
  (send-and-print o (conc (sessionstr) " SEARCH "typeflag))
  (let loop ((result '()))
    (let* ((inl   (get-one-line i))
	   (parts (string-split inl))) ;; is it needed to check for eof here?
      (match parts
	((sstr "OK" restype status . rem)
	 (if (member status '("Done" "completed"))
	     result
	     (begin
	       (print "BAD STATUS: "status)
	       result)))
	((sstr "SEARCH" quant)
	 (loop (cons (string->number quant) result)))
	(else (loop result))))))

;; (FLAGS BODY[HEADER.FIELDS (DATE FROM)])
;; (FLAGS BODY[TEXT])
(define (fetch i o msgnum #!optional (section "BODY.ALL"))
  ;;   F1 OK Fetch completed 
  (send-and-print o (conc (sessionstr) " FETCH "msgnum" "section)) ;; ("section")"))
  (let loop ((result '()))
    (let* ((inl   (get-one-line i))
	   (parts (string-split inl))) ;; is it needed to check for eof here?
      (match parts
	((sstr "OK" restype status . rem)
	 (if (member status '("Done" "completed"))
	     (reverse result)
	     (begin
	       (print "BAD STATUS: "status)
	       (reverse result))))
	(else (loop (cons inl result)))))))

(define (close-and-logout i o)
  (send-and-print o (conc (sessionstr) " CLOSE"))
  (send-and-print o (conc (sessionstr) " LOGOUT")))

(define (test-it)
  (verbosity 10)
  (let* ((emailadr "nicolaus_pentland@egis5edc6gnr3q7mu2sdnbdjrwyuzyqyttouitd4nhpaywgfdusq.freemail")
	 (passwd (get-input-from-console "Enter password:")))
    (with-connection
     (lambda (i o)
       (login i o emailadr passwd)
       (print (list-email i o "*"))
       (print (select-folder i o "INBOX"))
       (print (search i o))
       (print (fetch i o 1))
       (let loop ()
	 (write "Enter section: (STOP to end)")
	 (let* ((section (read-line)))
	   (if (not (equal? section "STOP"))
	       (begin
		 (print "\nSection="section"\n"(fetch i o 1 section))
		 (loop)))))
       (close-and-logout)))))

;; (test-it)
;; LIST FOLDERS

;; LIST EMAILS IN INBOX

;; RETRIEVE EMAIL FROM INBOX

;; DELETE EMAIL FROM INBOX

;; (define *vars* (make-hash-table))
;; (define (save-vars dats)
;;   (map (lambda (dat)
;; 	 (hash-table-set! *vars* (car dat)(cdr dat)))
;;        dats))
;; 
;; ;; wait until val (a regex) matches an item in the input queue
;; ;; then clear the queue
;; ;;
;; (define (input-wait i val)
;;   (doprint 2 "Waiting for: "val)
;;   (let loop ()
;;     (let ((inl (read-line i)))
;;       (if (string-match val inl)
;; 	  (doprint 2 "Got: "inl)
;; 	  (begin
;; 	    (doprint 2 "Received: "inl)
;; 	    (loop))
;; 	  ))))
;; 
;; (define (addr->baseaddress addr)
;;   (match (string-match "^(\\S+)\\s+(\\S+)\\s+<(.*)>$" addr)
;;     ((_ firstname lastname baseaddress)
;;      baseaddress)
;;     (else
;;      addr)))
;; 
;; ;; get the next message and return an alist of vars
;; ;; with _msgtype_ set to the message type
;; ;;
;; (define (get-next-message i)
;;   (let loop ((res    '())
;; 	     (msgtype #f))
;;     (let* ((inl (read-line i)))
;;       (doprint 2 "Recv: "inl)
;;       (if (not (eof-object? inl))
;; 	  (if (not msgtype) ;; first line must be the type
;; 	      (if (string-match ".*=.*" inl) ;; should never have an = in a message type
;; 		  (begin
;; 		    (doprint 0 "ERROR: expecting message type but got \""inl"\"")
;; 		    (loop res msgtype))
;; 		  (loop (cons `(_msgtype_ . ,inl) res) inl))
;; 	      (match (string-match "^([^=]+)=(.*)$" inl)
;; 		((_ var val)(loop (cons `(,(string->symbol var) . ,val) res) msgtype))
;; 		(else
;; 		 (if (equal? inl "EndMessage")
;; 		     res
;; 		     (begin
;; 		       (doprint 0 "ERROR: expecting either var=val or EndMessage but got \""inl"\"")
;; 		       (loop res msgtype))))))
;; 	  res))))
;; 		   
;; 
;; (define (send-var o var val)
;;   (send-and-print o (conc var"="val)))
;; 
;; ;; Hello
;; 
;; (define (client-send-hello o idstr)
;;   (send-and-print o "ClientHello")
;;   (send-var o "Name" idstr)
;;   (send-var o "ExpectedVersion" "2.0")
;;   (send-and-print o "EndMessage"))
;; 
;; (define (wait-for-node-hello i)
;;   (let* ((dat (get-next-message i))
;; 	 (mtp (alist-ref '_msgtype_ dat)))
;;     (if (equal? mtp "NodeHello")
;; 	(begin
;; 	  (save-vars dat)
;; 	  #t)
;; 	(begin
;; 	  (doprint 0 "ERROR: Expected NodeHello message but got "mtp)
;; 	  #f))))
;; 
;; (define (send-watch-global o)
;;   (send-and-print o "WatchGlobal")
;;   (send-var o "Enabled" "true")
;;   (send-var o "VerbosityMask" "1")
;;   (send-and-print o "EndMessage"))
;; 
;; (define (test-dda i o directory)
;;   (send-and-print o "TestDDARequest")
;;   (send-var o "Directory" directory)
;;   (send-var o "WantReadDirectory" "true")
;;   (send-var o "WantWriteDirectory" "true")
;;   (send-and-print o "EndMessage")
;;   (thread-sleep! 1) ;; is there a deterministic way?
;;   (let loop ()
;;     (if (char-ready? i)
;; 	(let* ((msg (get-next-message i)))
;; 	  (cond
;; 	   ((alist-ref 'ContentToWrite msg)
;; 	    (let* ((content (alist-ref 'ContentToWrite msg))
;; 		   (writefn (alist-ref 'WriteFilename msg))
;; 		   (readfn  (alist-ref 'ReadFilename msg)))
;; 	      (if (not (and msg content writefn readfn))
;; 		  (begin
;; 		    (doprint 0 "Got "msg" but missing content, writefn or readfn.")
;; 		    (loop))
;; 		  (let* ((resdat  (with-input-from-file readfn
;; 				    read-line)))
;; 		    (with-output-to-file writefn
;; 		      (lambda ()
;; 			(print content)))
;; 		    (send-and-print o "TestDDAResponse")
;; 		    (send-var o "Directory" directory)
;; 		    (send-var o "ReadContent" resdat)
;; 		    (send-and-print o "EndMessage")))))
;; 	   (else
;; 	    (doprint 0 "ERROR: in test-dda and got msg:\n" msg)
;; 	    (loop))))
;; 	(begin ;; no input, sleep and peek again
;; 	  (thread-sleep! 5)
;; 	  (loop))))
;;   (get-next-message i)) ;; should be the TestDDAComplete
;; 
;; (define (retrieve-file uri directory fname)
;;   (let ((key (make-key (current-seconds) directory fname))
;; 	(fullname (conc directory"/"fname)))
;;     (with-connection
;;      key
;;      (lambda (i o)
;;        (test-dda i o directory)
;;        (send-and-print o "ClientGet")
;;        (send-var o "IgnoreDS" "false")
;;        (send-var o "DSOnly" "false")
;;        (send-var o "URI" uri)
;;        (send-var o "Identifier" key)
;;        (send-var o "Verbosity" "0")
;;        (send-var o "ReturnType" "disk")
;;        ;; (send-var o "MaxSize" "100")
;;        ;; (send-var o "MaxTempSize" "1000")
;;        (send-var o "MaxRetries" "100")
;;        (send-var o "PriorityClass" "1")
;;        (send-var o "Persistence" "reboot")
;;        (send-var o "ClientToken" "hello")
;;        (send-var o "Global" "true")
;;        (send-var o "BinaryBlob" "false")
;;        ;; (send-var o "FilterData" "true")
;;        (send-var o "Filename" fullname)
;;        (send-and-print o "EndMessage")
;;        (send-watch-global o)
;;        (let loop ()
;; 	 (let* ((msg (if (char-ready? i)
;; 			 (get-next-message i)
;; 			 #f))
;; 		(msgforus (and msg (equal? (alist-ref 'Identifier msg) key)))
;; 		(msgtype  (and msg (alist-ref '_msgtype_ msg))))
;; 	   (if msgforus
;; 	       (cond
;; 		((equal? msgtype "ProtocolError")
;; 		 (doprint 0 "ERROR: "(or (alist-ref 'CodeDescription msg)
;; 					 (conc "unknown error\nmessage="msg)))
;; 		 #f) ;; stop, failed
;; 		((member msgtype '("PersistentGet" "CompatibilityMode"));; these are ok, keep going
;; 		 (loop))
;; 		((alist-ref 'Succeeded msg)
;; 		 (doprint 1 "Progress: "
;; 			  "retrieved "(alist-ref 'Succeeded msg)
;; 			  " out of "(alist-ref 'Required msg)
;; 			  " and "(alist-ref 'Total msg)" ("(or (alist-ref 'FinalizedTotal msg) "")")")
;; 		 (if (and (equal? (alist-ref 'FinalizedTotal msg) "true")
;; 			  (file-exists? fullname))
;; 		     #t ;; stop, succeeded
;; 		     (if (and (equal? (alist-ref 'Min msg) "COMPAT_UNKNOWN")
;; 			      (equal? (alist-ref 'Max msg) "COMPAT_UNKNOWN"))
;; 			 (begin
;; 			   (doprint 0 "Failed to find "uri)
;; 			   #f) ;; stop, failed
;; 			 (begin
;; 			   (thread-sleep! 1)
;; 			   (loop))))) ;; keep going
;; 		(else
;; 		 (doprint 0 "Unaccounted for message: \n"msg)
;; 		 (loop)))
;; 	       (begin
;; 		 (thread-sleep! 1)
;; 		 (loop)))))))))
;;  
;; ;; address format "First Last <first_last@something.freenet>"
;; ;;
;; (define (insert-file directory fname #!optional (uri #f))
;;   (let ((key (make-key (current-seconds) directory fname)))
;;     (with-connection
;;      key
;;      (lambda (i o)
;;        ;; first send the DDA request
;;        (test-dda i o directory)
;;        
;;        (send-and-print o "ClientPut")
;;        (send-var o "URI" (or uri "CHK@"))
;;        (send-var o "UploadFrom" "disk")
;;        (send-var o "Filename" (conc directory"/"fname))
;;        (send-var o "Identifier" key)
;;        ;; (send-var o "ClientToken" This is the debian sarge dvd number 1
;;        (send-var o "Global" "true") ;; it'd be nice if send-var took #t and #f
;;        (send-and-print o "EndMessage")
;;        
;;        (send-watch-global o)
;;        (let loop  ()
;; 	 (if (char-ready? i)
;; 	     (let* ((dats (get-next-message i))
;; 		    (mtp  (alist-ref '_msgtype_ dats)))
;; 	       (doprint 2 "GOT: "dats)
;; 	       (if (equal? mtp "URIGenerated")
;; 		   (alist-ref 'URI dats)
;; 		   (loop)))
;; 	     (begin
;; 	       (display ".")
;; 	       (flush-output)
;; 	       (thread-sleep! 5)
;; 	       (loop))))))))
;; 
;; ;; (insert-file "/home/matt" ".bashrc")
;; ;; address format "First Last <first_last@something.freenet>"
;; ;;
;; (define (gen-ssk)
;;   (let* ((key (make-key (current-seconds) (current-process-id))))
;;     (with-connection
;;      key
;;      (lambda (i o)
;;        (send-and-print o "GenerateSSK")
;;        (send-var o "Identifier" key)
;;        (send-and-print o "EndMessage")
;;        ;; SSKKeypair
;;        ;; InsertURI=freenet:SSK@AKTTKG6YwjrHzWo67laRcoPqibyiTdyYufjVg54fBlWr,AwUSJG5ZS-FDZTqnt6skTzhxQe08T-fbKXj8aEHZsXM/
;;        ;; RequestURI=freenet:SSK@BnHXXv3Fa43w~~iz1tNUd~cj4OpUuDjVouOWZ5XlpX0,AwUSJG5ZS-FDZTqnt6skTzhxQe08T-fbKXj8aEHZsXM,AQABAAE/
;;        ;; Identifier=My Identifier from GenerateSSK
;;        ;; EndMessage
;;        (let loop ()
;; 	 (let* ((msg (if (char-ready? i)
;; 			 (get-next-message i)
;; 			 #f)))
;; 	   (pp msg)
;; 	   (if msg
;; 	       (if (and (equal? (alist-ref '_msgtype_ msg) "SSKKeypair")
;; 			(equal? (alist-ref 'Identifier msg) key))
;; 		   msg
;; 		   (begin
;; 		     (thread-sleep! 1)
;; 		     (loop)))(define *vars* (make-hash-table))
;; (define (save-vars dats)
;;   (map (lambda (dat)
;; 	 (hash-table-set! *vars* (car dat)(cdr dat)))
;;        dats))
;; 
;; ;; wait until val (a regex) matches an item in the input queue
;; ;; then clear the queue
;; ;;
;; (define (input-wait i val)
;;   (doprint 2 "Waiting for: "val)
;;   (let loop ()
;;     (let ((inl (read-line i)))
;;       (if (string-match val inl)
;; 	  (doprint 2 "Got: "inl)
;; 	  (begin
;; 	    (doprint 2 "Received: "inl)
;; 	    (loop))
;; 	  ))))
;; 
;; (define (addr->baseaddress addr)
;;   (match (string-match "^(\\S+)\\s+(\\S+)\\s+<(.*)>$" addr)
;;     ((_ firstname lastname baseaddress)
;;      baseaddress)
;;     (else
;;      addr)))
;; 
;; ;; get the next message and return an alist of vars
;; ;; with _msgtype_ set to the message type
;; ;;
;; (define (get-next-message i)
;;   (let loop ((res    '())
;; 	     (msgtype #f))
;;     (let* ((inl (read-line i)))
;;       (doprint 2 "Recv: "inl)
;;       (if (not (eof-object? inl))
;; 	  (if (not msgtype) ;; first line must be the type
;; 	      (if (string-match ".*=.*" inl) ;; should never have an = in a message type
;; 		  (begin
;; 		    (doprint 0 "ERROR: expecting message type but got \""inl"\"")
;; 		    (loop res msgtype))
;; 		  (loop (cons `(_msgtype_ . ,inl) res) inl))
;; 	      (match (string-match "^([^=]+)=(.*)$" inl)
;; 		((_ var val)(loop (cons `(,(string->symbol var) . ,val) res) msgtype))
;; 		(else
;; 		 (if (equal? inl "EndMessage")
;; 		     res
;; 		     (begin
;; 		       (doprint 0 "ERROR: expecting either var=val or EndMessage but got \""inl"\"")
;; 		       (loop res msgtype))))))
;; 	  res))))
;; 		   
;; 
;; (define (send-var o var val)
;;   (send-and-print o (conc var"="val)))
;; 
;; ;; Hello
;; 
;; (define (client-send-hello o idstr)
;;   (send-and-print o "ClientHello")
;;   (send-var o "Name" idstr)
;;   (send-var o "ExpectedVersion" "2.0")
;;   (send-and-print o "EndMessage"))
;; 
;; (define (wait-for-node-hello i)
;;   (let* ((dat (get-next-message i))
;; 	 (mtp (alist-ref '_msgtype_ dat)))
;;     (if (equal? mtp "NodeHello")
;; 	(begin
;; 	  (save-vars dat)
;; 	  #t)
;; 	(begin
;; 	  (doprint 0 "ERROR: Expected NodeHello message but got "mtp)
;; 	  #f))))
;; 
;; (define (send-watch-global o)
;;   (send-and-print o "WatchGlobal")
;;   (send-var o "Enabled" "true")
;;   (send-var o "VerbosityMask" "1")
;;   (send-and-print o "EndMessage"))
;; 
;; (define (test-dda i o directory)
;;   (send-and-print o "TestDDARequest")
;;   (send-var o "Directory" directory)
;;   (send-var o "WantReadDirectory" "true")
;;   (send-var o "WantWriteDirectory" "true")
;;   (send-and-print o "EndMessage")
;;   (thread-sleep! 1) ;; is there a deterministic way?
;;   (let loop ()
;;     (if (char-ready? i)
;; 	(let* ((msg (get-next-message i)))
;; 	  (cond
;; 	   ((alist-ref 'ContentToWrite msg)
;; 	    (let* ((content (alist-ref 'ContentToWrite msg))
;; 		   (writefn (alist-ref 'WriteFilename msg))
;; 		   (readfn  (alist-ref 'ReadFilename msg)))
;; 	      (if (not (and msg content writefn readfn))
;; 		  (begin
;; 		    (doprint 0 "Got "msg" but missing content, writefn or readfn.")
;; 		    (loop))
;; 		  (let* ((resdat  (with-input-from-file readfn
;; 				    read-line)))
;; 		    (with-output-to-file writefn
;; 		      (lambda ()
;; 			(print content)))
;; 		    (send-and-print o "TestDDAResponse")
;; 		    (send-var o "Directory" directory)
;; 		    (send-var o "ReadContent" resdat)
;; 		    (send-and-print o "EndMessage")))))
;; 	   (else
;; 	    (doprint 0 "ERROR: in test-dda and got msg:\n" msg)
;; 	    (loop))))
;; 	(begin ;; no input, sleep and peek again
;; 	  (thread-sleep! 5)
;; 	  (loop))))
;;   (get-next-message i)) ;; should be the TestDDAComplete
;; 
;; (define (with-connection key proc)
;;   (let-values (((i o)(tcp-connect (host) (port))))
;;     ;; idea was to do the hello here, however it didn't work.
;;     (client-send-hello o key) ;; dunno why this didn't seem to work
;;     (wait-for-node-hello i)   ;; same calls still needed when with-connection used
;;     (let* ((result (proc i o)))
;;       (close-input-port i)
;;       (close-output-port o)
;;       result)))
;; 
;; (define (retrieve-file uri directory fname)
;;   (let ((key (make-key (current-seconds) directory fname))
;; 	(fullname (conc directory"/"fname)))
;;     (with-connection
;;      key
;;      (lambda (i o)
;;        (test-dda i o directory)
;;        (send-and-print o "ClientGet")
;;        (send-var o "IgnoreDS" "false")
;;        (send-var o "DSOnly" "false")
;;        (send-var o "URI" uri)
;;        (send-var o "Identifier" key)
;;        (send-var o "Verbosity" "0")
;;        (send-var o "ReturnType" "disk")
;;        ;; (send-var o "MaxSize" "100")
;;        ;; (send-var o "MaxTempSize" "1000")
;;        (send-var o "MaxRetries" "100")
;;        (send-var o "PriorityClass" "1")
;;        (send-var o "Persistence" "reboot")
;;        (send-var o "ClientToken" "hello")
;;        (send-var o "Global" "true")
;;        (send-var o "BinaryBlob" "false")
;;        ;; (send-var o "FilterData" "true")
;;        (send-var o "Filename" fullname)
;;        (send-and-print o "EndMessage")
;;        (send-watch-global o)
;;        (let loop ()
;; 	 (let* ((msg (if (char-ready? i)
;; 			 (get-next-message i)
;; 			 #f))
;; 		(msgforus (and msg (equal? (alist-ref 'Identifier msg) key)))
;; 		(msgtype  (and msg (alist-ref '_msgtype_ msg))))
;; 	   (if msgforus
;; 	       (cond
;; 		((equal? msgtype "ProtocolError")
;; 		 (doprint 0 "ERROR: "(or (alist-ref 'CodeDescription msg)
;; 					 (conc "unknown error\nmessage="msg)))
;; 		 #f) ;; stop, failed
;; 		((member msgtype '("PersistentGet" "CompatibilityMode"));; these are ok, keep going
;; 		 (loop))
;; 		((alist-ref 'Succeeded msg)
;; 		 (doprint 1 "Progress: "
;; 			  "retrieved "(alist-ref 'Succeeded msg)
;; 			  " out of "(alist-ref 'Required msg)
;; 			  " and "(alist-ref 'Total msg)" ("(or (alist-ref 'FinalizedTotal msg) "")")")
;; 		 (if (and (equal? (alist-ref 'FinalizedTotal msg) "true")
;; 			  (file-exists? fullname))
;; 		     #t ;; stop, succeeded
;; 		     (if (and (equal? (alist-ref 'Min msg) "COMPAT_UNKNOWN")
;; 			      (equal? (alist-ref 'Max msg) "COMPAT_UNKNOWN"))
;; 			 (begin
;; 			   (doprint 0 "Failed to find "uri)
;; 			   #f) ;; stop, failed
;; 			 (begin
;; 			   (thread-sleep! 1)
;; 			   (loop))))) ;; keep going
;; 		(else
;; 		 (doprint 0 "Unaccounted for message: \n"msg)
;; 		 (loop)))
;; 	       (begin
;; 		 (thread-sleep! 1)
;; 		 (loop)))))))))
;;  
;; ;; address format "First Last <first_last@something.freenet>"
;; ;;
;; (define (insert-file directory fname #!optional (uri #f))
;;   (let ((key (make-key (current-seconds) directory fname)))
;;     (with-connection
;;      key
;;      (lambda (i o)
;;        ;; first send the DDA request
;;        (test-dda i o directory)
;;        
;;        (send-and-print o "ClientPut")
;;        (send-var o "URI" (or uri "CHK@"))
;;        (send-var o "UploadFrom" "disk")
;;        (send-var o "Filename" (conc directory"/"fname))
;;        (send-var o "Identifier" key)
;;        ;; (send-var o "ClientToken" This is the debian sarge dvd number 1
;;        (send-var o "Global" "true") ;; it'd be nice if send-var took #t and #f
;;        (send-and-print o "EndMessage")
;;        
;;        (send-watch-global o)
;;        (let loop  ()
;; 	 (if (char-ready? i)
;; 	     (let* ((dats (get-next-message i))
;; 		    (mtp  (alist-ref '_msgtype_ dats)))
;; 	       (doprint 2 "GOT: "dats)
;; 	       (if (equal? mtp "URIGenerated")
;; 		   (alist-ref 'URI dats)
;; 		   (loop)))
;; 	     (begin
;; 	       (display ".")
;; 	       (flush-output)
;; 	       (thread-sleep! 5)
;; 	       (loop))))))))
;; 
;; ;; (insert-file "/home/matt" ".bashrc")
;; ;; address format "First Last <first_last@something.freenet>"
;; ;;
;; (define (gen-ssk)
;;   (let* ((key (make-key (current-seconds) (current-process-id))))
;;     (with-connection
;;      key
;;      (lambda (i o)
;;        (send-and-print o "GenerateSSK")
;;        (send-var o "Identifier" key)
;;        (send-and-print o "EndMessage")
;;        ;; SSKKeypair
;;        ;; InsertURI=freenet:SSK@AKTTKG6YwjrHzWo67laRcoPqibyiTdyYufjVg54fBlWr,AwUSJG5ZS-FDZTqnt6skTzhxQe08T-fbKXj8aEHZsXM/
;;        ;; RequestURI=freenet:SSK@BnHXXv3Fa43w~~iz1tNUd~cj4OpUuDjVouOWZ5XlpX0,AwUSJG5ZS-FDZTqnt6skTzhxQe08T-fbKXj8aEHZsXM,AQABAAE/
;;        ;; Identifier=My Identifier from GenerateSSK
;;        ;; EndMessage
;;        (let loop ()
;; 	 (let* ((msg (if (char-ready? i)
;; 			 (get-next-message i)
;; 			 #f)))
;; 	   (pp msg)
;; 	   (if msg
;; 	       (if (and (equal? (alist-ref '_msgtype_ msg) "SSKKeypair")
;; 			(equal? (alist-ref 'Identifier msg) key))
;; 		   msg
;; 		   (begin
;; 		     (thread-sleep! 1)
;; 		     (loop)))
;; 	       (begin
;; 		 (thread-sleep! 1)
;; 		 (loop)))))))))
;; 
;; (define (make-key . params)
;;   (let ((key (string-translate
;; 	      (base64-encode (string-intersperse (map conc params) "-"))
;; 	      "=" "x")))
;;     (doprint 2 "Created key "key)
;;     key))
;; 
;; (define (register-directory directory)
;;   ;; (let-values (((i o)(tcp-connect (host) (port))))
;;   ;;   (client-send-hello o key)
;;   ;;   (wait-for-node-hello i)
;;   (let ((key (make-key (current-seconds) directory)))
;;     (with-connection
;;      key
;;      (lambda (i o)
;;        ;; first send the DDA request
;;        (test-dda i o directory)))))
;; 	       (begin
;; 		 (thread-sleep! 1)
;; 		 (loop)))))))))
;; 
;; (define (make-key . params)
;;   (let ((key (string-translate
;; 	      (base64-encode (string-intersperse (map conc params) "-"))
;; 	      "=" "x")))
;;     (doprint 2 "Created key "key)
;;     key))
;; 
;; (define (register-directory directory)
;;   ;; (let-values (((i o)(tcp-connect (host) (port))))
;;   ;;   (client-send-hello o key)
;;   ;;   (wait-for-node-hello i)
;;   (let ((key (make-key (current-seconds) directory)))
;;     (with-connection
;;      key
;;      (lambda (i o)
;;        ;; first send the DDA request
;;        (test-dda i o directory)))))
;;   
)