From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/59037 Path: main.gmane.org!not-for-mail From: Magnus Henoch Newsgroups: gmane.emacs.gnus.general Subject: Asynchronous hashcash.el Date: Tue, 02 Nov 2004 18:08:28 +0100 Message-ID: NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: sea.gmane.org 1099415679 27822 80.91.229.6 (2 Nov 2004 17:14:39 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Tue, 2 Nov 2004 17:14:39 +0000 (UTC) Original-X-From: ding-owner+M7577@lists.math.uh.edu Tue Nov 02 18:14:17 2004 Return-path: Original-Received: from malifon.math.uh.edu ([129.7.128.13] ident=mail) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 1CP2Ea-0007bb-00 for ; Tue, 02 Nov 2004 18:14:17 +0100 Original-Received: from localhost ([127.0.0.1] helo=lists.math.uh.edu ident=lists) by malifon.math.uh.edu with smtp (Exim 3.20 #1) id 1CP29J-0000ae-00; Tue, 02 Nov 2004 11:08:49 -0600 Original-Received: from util2.math.uh.edu ([129.7.128.23]) by malifon.math.uh.edu with esmtp (Exim 3.20 #1) id 1CP29B-0000aY-00 for ding@lists.math.uh.edu; Tue, 02 Nov 2004 11:08:41 -0600 Original-Received: from justine.libertine.org ([66.139.78.221] ident=postfix) by util2.math.uh.edu with esmtp (Exim 4.30) id 1CP298-00058h-RA for ding@lists.math.uh.edu; Tue, 02 Nov 2004 11:08:38 -0600 Original-Received: from main.gmane.org (main.gmane.org [80.91.229.2]) by justine.libertine.org (Postfix) with ESMTP id DA4113A0242 for ; Tue, 2 Nov 2004 11:08:36 -0600 (CST) Original-Received: from list by main.gmane.org with local (Exim 3.35 #1 (Debian)) id 1CP294-0006DB-00 for ; Tue, 02 Nov 2004 18:08:34 +0100 Original-Received: from h170n1fls23o1074.bredband.comhem.se ([213.67.239.170]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Tue, 02 Nov 2004 18:08:34 +0100 Original-Received: from mange by h170n1fls23o1074.bredband.comhem.se with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Tue, 02 Nov 2004 18:08:34 +0100 X-Injected-Via-Gmane: http://gmane.org/ Original-To: ding@gnus.org Original-Lines: 277 Original-X-Complaints-To: usenet@sea.gmane.org X-Gmane-NNTP-Posting-Host: h170n1fls23o1074.bredband.comhem.se User-Agent: Gnus/5.11 (Gnus v5.11) Emacs/21.3.50 (darwin) Cancel-Lock: sha1:zrVD84SvnYHkuTzxGaNg1dl17GY= Precedence: bulk Original-Sender: ding-owner@lists.math.uh.edu Xref: main.gmane.org gmane.emacs.gnus.general:59037 X-Report-Spam: http://spam.gmane.org/gmane.emacs.gnus.general:59037 --=-=-= 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 * 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=hashcash-async.patch --- 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." --=-=-=--