X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=contrib%2Fhashcash.el;h=6966b211812d2ca76e511d51e3ee9ef67d389304;hb=2ff131474a99f8d5658c3cd0e2398070750d78ad;hp=5ec251f35ab7d46d22bc1584c3dfb2cc4351b6f2;hpb=d8f7efd1ce52b6a692873cc41a208d32aca02a59;p=elisp%2Fgnus.git-

diff --git a/contrib/hashcash.el b/contrib/hashcash.el
index 5ec251f..6966b21 100644
--- a/contrib/hashcash.el
+++ b/contrib/hashcash.el
@@ -1,11 +1,13 @@
 ;;; hashcash.el --- Add hashcash payments to email
 
-;; Copyright (C) 1997,2001 Paul E. Foley
+;; Copyright (C) 1997--2002 Paul E. Foley
+;; Copyright (C) 2003 Free Software Foundation
 
 ;; Maintainer: Paul Foley <mycroft@actrix.gen.nz>
 ;; Keywords: mail, hashcash
 
 ;; Released under the GNU General Public License
+;;   (http://www.gnu.org/licenses/gpl.html)
 
 ;;; Commentary:
 
@@ -21,6 +23,9 @@
 
 (eval-when-compile (require 'cl))
 
+(eval-and-compile
+ (autoload 'executable-find "executable"))
+
 (defcustom hashcash-default-payment 0
   "*The default number of bits to pay to unknown users.
 If this is zero, no payment header will be generated.
@@ -38,13 +43,13 @@ present, is the string to be hashed; if not present ADDR will be used.")
   "*The default minimum number of bits to accept on incoming payments."
   :type 'integer)
 
-(defcustom hashcash-accept-resources `((,(user-mail-address) nil))
+(defcustom hashcash-accept-resources `((,user-mail-address nil))
   "*An association list mapping hashcash resources to payment amounts.
 Resources named here are to be accepted in incoming payments.  If the
 corresponding AMOUNT is NIL, the value of `hashcash-default-accept-payment'
 is used instead.")
 
-(defcustom hashcash "/usr/local/bin/hashcash"
+(defcustom hashcash-path (executable-find "hashcash")
   "*The path to the hashcash binary.")
 
 (defcustom hashcash-double-spend-database "hashcash.db"
@@ -56,6 +61,16 @@ is used instead.")
 
 (require 'mail-utils)
 
+(defalias 'hashcash-point-at-bol
+    (if (fboundp 'point-at-bol)
+	'point-at-bol
+	'line-beginning-position))
+
+(defalias 'hashcash-point-at-eol
+    (if (fboundp 'point-at-eol)
+	'point-at-eol
+	'line-end-position))
+
 (defun hashcash-strip-quoted-names (addr)
   (setq addr (mail-strip-quoted-names addr))
   (if (and addr (string-match "^[^+@]+\\(\\+[^@]*\\)@" addr))
@@ -87,20 +102,36 @@ is used instead.")
       (save-excursion
 	(set-buffer (get-buffer-create " *hashcash*"))
 	(erase-buffer)
-	(call-process hashcash nil t nil (concat "-b " (number-to-string val))
-		      str)
+	(call-process hashcash-path nil t nil
+		      (concat "-b " (number-to-string val)) str)
 	(goto-char (point-min))
-	(buffer-substring (point-at-bol) (point-at-eol)))
+	(buffer-substring (hashcash-point-at-bol) (hashcash-point-at-eol)))
     nil))
 
 (defun hashcash-check-payment (token str val)
   "Check the validity of a hashcash payment."
-  (zerop (call-process hashcash nil nil nil "-c"
+  (zerop (call-process hashcash-path nil nil nil "-c"
 		       "-d" "-f" hashcash-double-spend-database
 		       "-b" (number-to-string val)
 		       "-r" str
 		       token)))
 
+(defun hashcash-version (token)
+  "Find the format version of a hashcash token."
+  ;; Version 1.2 looks like n:yymmdd:rrrrr:xxxxxxxxxxxxxxxx
+  ;;   This carries its own version number embedded in the token,
+  ;;   so no further format number changes should be necessary
+  ;;   in the X-Payment header.
+  ;;
+  ;; Version 1.1 looks like yymmdd:rrrrr:xxxxxxxxxxxxxxxx
+  ;;   You need to upgrade your hashcash binary.
+  ;;
+  ;; Version 1.0 looked like nnnnnrrrrrxxxxxxxxxxxxxxxx
+  ;;   This is no longer supported.
+  (cond ((equal (aref token 1) ?:) 1.2)
+	((equal (aref token 6) ?:) 1.1)
+	(t (error "Unknown hashcash format version"))))
+
 ;;;###autoload
 (defun hashcash-insert-payment (arg)
   "Insert X-Payment and X-Hashcash headers with a payment for ARG"
@@ -108,13 +139,17 @@ is used instead.")
   (let ((pay (hashcash-generate-payment (hashcash-payment-to arg)
 					(hashcash-payment-required arg))))
     (when pay
-      (insert-before-markers "X-Payment: hashcash 1.1 " 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 (cadr (split-string-by-char token ?:))))
+  (let ((key (if (< (hashcash-version token) 1.2)
+		 (cadr (split-string token ":"))
+		 (caddr (split-string token ":")))))
     (cond ((null resource)
 	   (let ((elt (assoc key hashcash-accept-resources)))
 	     (and elt (hashcash-check-payment token (car elt)
@@ -160,25 +195,27 @@ for each recipient address.  Prefix arg sets default payment temporarily."
 Prefix arg sets default accept amount temporarily."
   (interactive "P")
   (let ((hashcash-default-accept-payment (if arg (prefix-numeric-value arg)
-					   hashcash-default-accept-payment)))
+					   hashcash-default-accept-payment))
+	(version (hashcash-version (hashcash-generate-payment "x" 1))))
     (save-excursion
       (goto-char (point-min))
-      (search-forward mail-header-separator)
+      (search-forward "\n\n")
       (beginning-of-line)
       (let ((end (point))
 	    (ok nil))
 	(goto-char (point-min))
-	(while (and (not ok) (search-forward "X-Payment: hashcash 1.1 " end t))
-	  (setq ok (hashcash-verify-payment
-		    (buffer-substring (point) (point-at-eol)))))
+	(while (and (not ok) (search-forward "X-Payment: hashcash " end t))
+	  (let ((value (split-string
+			  (buffer-substring (point) (hashcash-point-at-eol))
+			  " ")))
+	    (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) (point-at-eol)))))
+		    (buffer-substring (point) (hashcash-point-at-eol)))))
 	(when ok
 	  (message "Payment valid"))
 	ok))))
 
 (provide 'hashcash)
-
-;;; hashcash.el ends here