X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=contrib%2Fhashcash.el;h=c407dfb11c9ba4e4591e4f5c6de812cc63f42c3c;hb=408840801f86faa31bb06cef9d8bfe361d78b094;hp=3770212187740499c71bb3539b4c252934850ac9;hpb=363be8f069f55f9fe6a98798384c2cdd97b740d4;p=gnus

diff --git a/contrib/hashcash.el b/contrib/hashcash.el
index 377021218..c407dfb11 100644
--- a/contrib/hashcash.el
+++ b/contrib/hashcash.el
@@ -1,8 +1,8 @@
 ;;; hashcash.el --- Add hashcash payments to email
 
-;; $Revision: 1.10 $
-;; Copyright (C) 1997--2002 Paul E. Foley
+;; $Revision: 1.12 $
 ;; Copyright (C) 2003 Free Software Foundation
+;; Copyright (C) 1997--2002 Paul E. Foley
 
 ;; Maintainer: Paul Foley <mycroft@actrix.gen.nz>
 ;; Keywords: mail, hashcash
@@ -60,37 +60,30 @@ is used instead.")
 
 (require 'mail-utils)
 
-(if (fboundp 'point-at-bol)
-    (defalias 'hashcash-point-at-bol 'point-at-bol)
-  (defalias 'hashcash-point-at-bol 'line-beginning-position))
+(eval-and-compile
+ (if (fboundp 'point-at-bol)
+     (defalias 'hashcash-point-at-bol 'point-at-bol)
+   (defalias 'hashcash-point-at-bol 'line-beginning-position))
 
-(if (fboundp 'point-at-eol)
-    (defalias 'hashcash-point-at-eol 'point-at-eol)
-  (defalias 'hashcash-point-at-eol 'line-end-position))
+ (if (fboundp 'point-at-eol)
+     (defalias 'hashcash-point-at-eol 'point-at-eol)
+   (defalias 'hashcash-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))
-      (concat (subseq addr 0 (match-beginning 1)) (subseq addr (match-end 1)))
+  (if (and addr (string-match "\\`\\([^+@]+\\)\\+[^@]*\\(@.+\\)" addr))
+      (concat (match-string 1 addr) (match-string 2 addr))
     addr))
 
 (defun hashcash-payment-required (addr)
   "Return the hashcash payment value required for the given address."
   (let ((val (assoc addr hashcash-payment-alist)))
-    (if val
-	(if (cddr val)
-	    (caddr val)
-	  (cadr val))
-      hashcash-default-payment)))
+    (or (nth 2 val) (nth 1 val) hashcash-default-payment)))
 
 (defun hashcash-payment-to (addr)
   "Return the string with which hashcash payments should collide."
   (let ((val (assoc addr hashcash-payment-alist)))
-    (if val
-	(if (cddr val)
-	    (cadr val)
-	  (car val))
-      addr)))
+    (or (nth 1 val) (nth 0 val) addr)))
 
 (defun hashcash-generate-payment (str val)
   "Generate a hashcash payment by finding a VAL-bit collison on STR."
@@ -99,7 +92,7 @@ is used instead.")
 	(set-buffer (get-buffer-create " *hashcash*"))
 	(erase-buffer)
 	(call-process hashcash-path nil t nil
-		      (concat "-b " (number-to-string val)) str)
+		      "-m" "-q" "-b" (number-to-string val) str)
 	(goto-char (point-min))
 	(buffer-substring (hashcash-point-at-bol) (hashcash-point-at-eol)))
     nil))
@@ -135,17 +128,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 "
-			     (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)
-		 (cadr (split-string token ":"))
-		 (caddr (split-string token ":")))))
+		 (nth 1 (split-string token ":"))
+		 (nth 2 (split-string token ":")))))
     (cond ((null resource)
 	   (let ((elt (assoc key hashcash-accept-resources)))
 	     (and elt (hashcash-check-payment token (car elt)
@@ -180,7 +173,7 @@ for each recipient address.  Prefix arg sets default payment temporarily."
 	  (when (and hashcash-in-news ng)
 	    (setq addrlist (nconc addrlist (split-string ng ",[ \t\n]*")))))
 	(when addrlist
-	  (mapc #'hashcash-insert-payment addrlist)))))
+	  (mapcar #'hashcash-insert-payment addrlist))))) ; mapc
   t)
 
 ;;;###autoload