Gnus development mailing list
 help / color / mirror / Atom feed
* Asynchronous hashcash.el
@ 2004-11-02 17:08 Magnus Henoch
  2004-11-02 21:11 ` Simon Josefsson
                   ` (2 more replies)
  0 siblings, 3 replies; 26+ messages in thread
From: Magnus Henoch @ 2004-11-02 17:08 UTC (permalink / raw)


[-- Attachment #1: Type: text/plain, Size: 2518 bytes --]

This is my first attempt at making hashcash.el asynchronous.  It
doesn't address all the ideas brought up in the discussion here, but
it's a good start.

User-visible changes:

* New function mail-add-payment-async takes all recipients in To and
  CC headers and starts generating hashcash tokens for them
  asynchronously.
* New function hashcash-cancel-async stops all asynchronous hashcash
  processes for the current buffer.
* New function hashcash-wait-async waits for all asynchronous hashcash
  processes in the current buffer to finish.
* New function hashcash-wait-or-cancel does one of the above depending
  on user input.
* hashcash-default-payment and hashcash-default-accept-payment are now
  20 by default, as recommended near the end of
  http://www.hashcash.org/dev/ .

Recommended hooks:

(add-hook 'message-setup-hook 'mail-add-payment-async)
(add-hook 'message-send-hook 'hashcash-wait-or-cancel)

Unfeatures:

* Asynchronous processes are not started automatically when you enter
  new addresses; you have to type M-x mail-add-payment-async
  yourself.  It seems that an idle timer, checking for point being
  outside of the header (to prevent tokens for halfwritten addresses)
  would be the solution.
* Incrementally increasing the collision length while the message is
  being written is not implemented.  Strictly speaking this is
  impossible, as the collision length is part of the hashed string,
  but this could be emulated, calculating longer and discarding
  shorter tokens.  I'm not sure it's worth it, though.

Bugs:

* If you call mail-add-payment{,-async} while a token is being
  generated asynchronously, you will get duplicate tokens.  Tokens
  already generated and inserted in the buffer are not duplicated,
  though, using hashcash-already-paid-p.

Changelog:

2004-11-02  Magnus Henoch  <mange@freemail.hu>

	* hashcash.el (hashcash-default-payment): Change default to 20
	(hashcash-default-accept-payment): Change default to 20
	(hashcash-process-alist): New variable
	(hashcash-generate-payment-async): Add
	(hashcash-already-paid-p): Add
	(hashcash-insert-payment): Don't generate payments twice
	(hashcash-insert-payment-async): Add
	(hashcash-insert-payment-async-2): Add
	(hashcash-cancel-async): Add
	(hashcash-wait-async): Add
	(hashcash-processes-running-p): Add
	(hashcash-wait-or-cancel): Add
	(mail-add-payment): New optional argument.  Conditionally start
	asynchronous calculation.
	(mail-add-payment-async): Add

What do you think about this?

Regards,
Magnus



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: hashcash-async.patch --]
[-- Type: text/x-patch, Size: 7168 bytes --]

--- orig/lisp/hashcash.el
+++ mod/lisp/hashcash.el
@@ -32,13 +32,23 @@
 ;;
 ;; To automatically add payments to all outgoing mail:
 ;;    (add-hook 'message-send-hook 'mail-add-payment)
+;;
+;; Call mail-add-payment-async after writing the addresses but before
+;; writing the mail to start calculating the hashcash payment
+;; asynchronously.
+;;
+;; To do this automatically when addresses are prefilled:
+;;    (add-hook 'message-setup-hook 'mail-add-payment-async)
+;;
+;; To check whether calculations are done before sending:
+;;    (add-hook 'message-send-hook 'hashcash-wait-or-cancel)
 
 ;;; Code:
 
 (eval-and-compile
  (autoload 'executable-find "executable"))
 
-(defcustom hashcash-default-payment 10
+(defcustom hashcash-default-payment 20
   "*The default number of bits to pay to unknown users.
 If this is zero, no payment header will be generated.
 See `hashcash-payment-alist'."
@@ -51,7 +61,7 @@
 the value of hashcash payment to be made to that user.  STRING, if
 present, is the string to be hashed; if not present ADDR will be used.")
 
-(defcustom hashcash-default-accept-payment 10
+(defcustom hashcash-default-accept-payment 20
   "*The default minimum number of bits to accept on incoming payments."
   :type 'integer)
 
@@ -71,6 +81,9 @@
   "*Specifies whether or not hashcash payments should be made to newsgroups."
   :type 'boolean)
 
+(defvar hashcash-process-alist nil
+  "Alist of asynchronous hashcash processes and buffers.")
+
 (require 'mail-utils)
 
 (eval-and-compile
@@ -122,6 +135,19 @@
 	(hashcash-token-substring))
     (error "No `hashcash' binary found")))
 
+(defun hashcash-generate-payment-async (str val callback)
+  "Generate a hashcash payment by finding a VAL-bit collison on STR.
+Return immediately.  Call CALLBACK with process and result when ready."
+  (if (> val 0)
+      (let ((process (start-process "hashcash" nil
+				    hashcash-path "-m" "-q" "-b" (number-to-string val) str)))
+	(setq hashcash-process-alist (cons
+				      (cons process (current-buffer))
+				      hashcash-process-alist))
+	(set-process-filter process `(lambda (process output)
+				       (funcall ,callback process output))))
+    (funcall callback nil)))
+
 (defun hashcash-check-payment (token str val)
   "Check the validity of a hashcash payment."
   (if hashcash-path
@@ -151,17 +177,87 @@
 	((equal (aref token 6) ?:) 1.1)
 	(t (error "Unknown hashcash format version"))))
 
+(defun hashcash-already-paid-p (recipient)
+  "Check for hashcash token to RECIPIENT in current buffer."
+  (save-excursion
+    (save-restriction
+      (message-narrow-to-headers-or-head)
+      (let ((token (message-fetch-field "x-hashcash")))
+	(and (stringp token)
+	     (string-match (regexp-quote recipient) token))))))
+
 ;;;###autoload
 (defun hashcash-insert-payment (arg)
   "Insert X-Payment and X-Hashcash headers with a payment for ARG"
   (interactive "sPay to: ")
-  (let ((pay (hashcash-generate-payment (hashcash-payment-to arg)
-					(hashcash-payment-required arg))))
-    (when pay
+  (unless (hashcash-already-paid-p arg)
+    (let ((pay (hashcash-generate-payment (hashcash-payment-to arg)
+					  (hashcash-payment-required arg))))
+      (when pay
+	;;      (insert-before-markers "X-Payment: hashcash "
+	;;			     (number-to-string (hashcash-version pay)) " "
+	;;			     pay "\n")
+	(insert-before-markers "X-Hashcash: " pay "\n")))))
+
+;;;###autoload
+(defun hashcash-insert-payment-async (arg)
+  "Insert X-Payment and X-Hashcash headers with a payment for ARG
+Only start calculation.  Results are inserted when ready."
+  (interactive "sPay to: ")
+  (unless (hashcash-already-paid-p arg)
+    (hashcash-generate-payment-async (hashcash-payment-to arg)
+				     (hashcash-payment-required arg)
+				     `(lambda (process payment)
+					(hashcash-insert-payment-async-2 ,(current-buffer) process payment)))))
+
+(defun hashcash-insert-payment-async-2 (buffer process pay)
+  (with-current-buffer buffer
+    (save-excursion
+      (save-restriction
+	(setq hashcash-process-alist (delq
+				      (assq process hashcash-process-alist)
+				      hashcash-process-alist))
+	(goto-char (point-min))
+	(search-forward mail-header-separator)
+	(beginning-of-line)
+	(when pay
 ;;      (insert-before-markers "X-Payment: hashcash "
 ;;			     (number-to-string (hashcash-version pay)) " "
 ;;			     pay "\n")
-      (insert-before-markers "X-Hashcash: " pay "\n"))))
+	  (insert-before-markers "X-Hashcash: " pay))))))
+
+(defun hashcash-cancel-async (&optional buffer)
+  "Delete any hashcash processes associated with BUFFER.
+BUFFER defaults to the current buffer."
+  (interactive)
+  (unless buffer (setq buffer (current-buffer)))
+  (let (entry)
+    (while (setq entry (rassq buffer hashcash-process-alist))
+      (delete-process (car entry))
+      (setq hashcash-process-alist
+	    (delq entry hashcash-process-alist)))))
+
+(defun hashcash-wait-async (&optional buffer)
+  "Wait for asynchronous hashcash processes in BUFFER to finish.
+BUFFER defaults to the current buffer."
+  (interactive)
+  (unless buffer (setq buffer (current-buffer)))
+  (let (entry)
+    (while (setq entry (rassq buffer hashcash-process-alist))
+      (accept-process-output (car entry)))))
+
+(defun hashcash-processes-running-p (buffer)
+  "Return non-nil if hashcash processes in BUFFER are still running."
+  (rassq buffer hashcash-process-alist))
+
+(defun hashcash-wait-or-cancel ()
+  "Ask user whether to wait for hashcash processes to finish."
+  (interactive)
+  (when (hashcash-processes-running-p (current-buffer))
+    (if (y-or-n-p 
+	  "Hashcash process(es) still running; wait for them to finish? ")
+	(hashcash-wait-async)
+      (hashcash-cancel-async))))
 
 ;;;###autoload
 (defun hashcash-verify-payment (token &optional resource amount)
@@ -182,9 +278,11 @@
 	  (t nil))))
 
 ;;;###autoload
-(defun mail-add-payment (&optional arg)
+(defun mail-add-payment (&optional arg async)
   "Add X-Payment: and X-Hashcash: headers with a hashcash payment
-for each recipient address.  Prefix arg sets default payment temporarily."
+for each recipient address.  Prefix arg sets default payment temporarily.
+Set ASYNC to t to start asynchronous calculation.  (See
+`mail-add-payment-async')."
   (interactive "P")
   (let ((hashcash-default-payment (if arg (prefix-numeric-value arg)
 				    hashcash-default-payment))
@@ -206,10 +304,21 @@
 	  (when (and hashcash-in-news ng)
 	    (setq addrlist (nconc addrlist (split-string ng ",[ \t\n]*")))))
 	(when addrlist
-	  (mapcar #'hashcash-insert-payment addrlist))))) ; mapc
+	  (mapcar (if async
+		      #'hashcash-insert-payment-async
+		    #'hashcash-insert-payment)
+		  addrlist))))) ; mapc
   t)
 
 ;;;###autoload
+(defun mail-add-payment-async (&optional arg)
+  "Add X-Payment: and X-Hashcash: headers with a hashcash payment
+for each recipient address.  Prefix arg sets default payment temporarily.
+Calculation is asynchronous."
+  (interactive "P")
+  (mail-add-payment arg t))
+
+;;;###autoload
 (defun mail-check-payment (&optional arg)
   "Look for a valid X-Payment: or X-Hashcash: header.
 Prefix arg sets default accept amount temporarily."




^ permalink raw reply	[flat|nested] 26+ messages in thread
end of thread, other threads:[~2004-12-01 13:13 UTC | newest]

Thread overview: 26+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2004-11-02 17:08 Asynchronous hashcash.el Magnus Henoch
2004-11-02 21:11 ` Simon Josefsson
2004-11-03 14:54   ` Magnus Henoch
2004-11-04 14:36     ` Simon Josefsson
2004-11-09 15:48       ` Magnus Henoch
2004-11-09 15:56       ` Magnus Henoch
2004-11-14  1:33 ` Dan Christensen
2004-11-14  1:59   ` Simon Josefsson
2004-11-14 13:59     ` Magnus Henoch
2004-11-14 14:28       ` Simon Josefsson
2004-11-14 16:42         ` Simon Josefsson
2004-11-14 20:43           ` Magnus Henoch
2004-11-14 23:14             ` Simon Josefsson
2004-11-16 20:13               ` Reiner Steib
2004-11-16 20:50                 ` Simon Josefsson
2004-11-14 23:02           ` Adam Sjøgren
2004-11-14 23:35             ` Simon Josefsson
2004-11-15 14:57               ` Adam Sjøgren
2004-11-15 17:17                 ` Simon Josefsson
2004-11-15  3:26       ` Dan Christensen
2004-11-15  9:39         ` Reiner Steib
2004-11-15 12:35         ` Simon Josefsson
2004-11-15 14:03           ` Kai Grossjohann
2004-12-01  7:09 ` Graham Murray
2004-12-01 10:23   ` Uwe Brauer
2004-12-01 13:13     ` Simon Josefsson

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).