From: Simon Josefsson <jas@extundo.com>
Date: Mon, 27 Sep 2004 14:28:21 +0000 (+0000)
Subject: 2004-09-27  Simon Josefsson  <jas@extundo.com>
X-Git-Url: https://cgit.sxemacs.org/?p=gnus;a=commitdiff_plain;h=6fd11510a48243141f4ca5e7b059f696254ecf04

2004-09-27  Simon Josefsson  <jas@extundo.com>

	* hashcash.el: Move to ../lisp/.

2004-09-27  Simon Josefsson  <jas@extundo.com>

	* hashcash.el: New version, from
	http://users.actrix.co.nz/mycroft/hashcash.el.  Previously in
	../contrib/.
---

diff --git a/contrib/ChangeLog b/contrib/ChangeLog
index 0957c9805..cd922c543 100644
--- a/contrib/ChangeLog
+++ b/contrib/ChangeLog
@@ -1,3 +1,7 @@
+2004-09-27  Simon Josefsson  <jas@extundo.com>
+
+	* hashcash.el: Move to ../lisp/.
+
 2004-07-30  TSUCHIYA Masatoshi  <tsuchiya@namazu.org>
 
 	* gnus-namazu.el (gnus-namazu/make-directory-table): Treat drive
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 741a2a46a..f87a99709 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2004-09-27  Simon Josefsson  <jas@extundo.com>
+
+	* hashcash.el: New version, from
+	http://users.actrix.co.nz/mycroft/hashcash.el.  Previously in
+	../contrib/.
+
 2004-09-27  Katsumi Yamaoka  <yamaoka@jpl.org>
 
 	* mm-decode.el (mm-copy-to-buffer): Don't use set-buffer-multibyte.
diff --git a/contrib/hashcash.el b/lisp/hashcash.el
similarity index 88%
rename from contrib/hashcash.el
rename to lisp/hashcash.el
index 087ba0c2a..7b0609cb2 100644
--- a/contrib/hashcash.el
+++ b/lisp/hashcash.el
@@ -1,7 +1,8 @@
 ;;; hashcash.el --- Add hashcash payments to email
 
-;; Copyright (C) 2003 Free Software Foundation
+;; $Revision: 1.13 $
 ;; Copyright (C) 1997--2002 Paul E. Foley
+;; Copyright (C) 2003 Free Software Foundation
 
 ;; Maintainer: Paul Foley <mycroft@actrix.gen.nz>
 ;; Keywords: mail, hashcash
@@ -24,7 +25,7 @@
 (eval-and-compile
  (autoload 'executable-find "executable"))
 
-(defcustom hashcash-default-payment 0
+(defcustom hashcash-default-payment 10
   "*The default number of bits to pay to unknown users.
 If this is zero, no payment header will be generated.
 See `hashcash-payment-alist'."
@@ -74,6 +75,17 @@ is used instead.")
       (concat (match-string 1 addr) (match-string 2 addr))
     addr))
 
+(defun hashcash-token-substring ()
+  (save-excursion
+    (let ((token ""))
+      (loop
+	(setq token
+	  (concat token (buffer-substring (point) (hashcash-point-at-eol))))
+	(goto-char (hashcash-point-at-eol))
+	(forward-char 1)
+	(unless (looking-at "[ \t]") (return token))
+	(while (looking-at "[ \t]") (forward-char 1))))))
+
 (defun hashcash-payment-required (addr)
   "Return the hashcash payment value required for the given address."
   (let ((val (assoc addr hashcash-payment-alist)))
@@ -93,7 +105,7 @@ is used instead.")
 	(call-process hashcash-path nil t nil
 		      "-m" "-q" "-b" (number-to-string val) str)
 	(goto-char (point-min))
-	(buffer-substring (hashcash-point-at-bol) (hashcash-point-at-eol)))
+	(hashcash-token-substring))
     nil))
 
 (defun hashcash-check-payment (token str val)
@@ -127,17 +139,20 @@ is used instead.")
   (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-Payment: hashcash "
+;;			     (number-to-string (hashcash-version pay)) " "
+;;			     pay "\n")
       (insert-before-markers "X-Hashcash: " pay "\n"))))
 
 ;;;###autoload
 (defun hashcash-verify-payment (token &optional resource amount)
   "Verify a hashcash payment"
-  (let ((key (if (< (hashcash-version token) 1.2)
-		 (nth 1 (split-string token ":"))
-		 (nth 2 (split-string token ":")))))
+  (let* ((split (split-string token ":"))
+	 (key (if (< (hashcash-version token) 1.2)
+		  (nth 1 split)
+		  (case (string-to-number (nth 0 split))
+		    (0 (nth 2 split))
+		    (1 (nth 3 split))))))
     (cond ((null resource)
 	   (let ((elt (assoc key hashcash-accept-resources)))
 	     (and elt (hashcash-check-payment token (car elt)
@@ -191,15 +206,12 @@ Prefix arg sets default accept amount temporarily."
 	    (ok nil))
 	(goto-char (point-min))
 	(while (and (not ok) (search-forward "X-Payment: hashcash " end t))
-	  (let ((value (split-string
-			  (buffer-substring (point) (hashcash-point-at-eol))
-			  " ")))
+	  (let ((value (split-string (hashcash-token-substring) " ")))
 	    (when (equal (car value) (number-to-string version))
 	      (setq ok (hashcash-verify-payment (cadr value))))))
 	(goto-char (point-min))
 	(while (and (not ok) (search-forward "X-Hashcash: " end t))
-	  (setq ok (hashcash-verify-payment
-		    (buffer-substring (point) (hashcash-point-at-eol)))))
+	  (setq ok (hashcash-verify-payment (hashcash-token-substring))))
 	(when ok
 	  (message "Payment valid"))
 	ok))))