[ Merge from Emacs: ]
[gnus] / lisp / hashcash.el
index 671149b..ac2e4a4 100644 (file)
@@ -1,8 +1,8 @@
 ;;; hashcash.el --- Add hashcash payments to email
 
-;; Copyright (C) 2003, 2004 Free Software Foundation
-;; Copyright (C) 1997--2002 Paul E. Foley
+;; Copyright (C) 2003, 2004, 2005 Free Software Foundation
 
+;; Written by: Paul Foley <mycroft@actrix.gen.nz> (1997-2002)
 ;; Maintainer: Paul Foley <mycroft@actrix.gen.nz>
 ;; Keywords: mail, hashcash
 
@@ -20,8 +20,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
 
 ;;; Code:
 
-(eval-and-compile
- (autoload 'executable-find "executable"))
+(defgroup hashcash nil
+  "Hashcash configuration."
+  :group 'mail)
 
 (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'."
-  :type 'integer)
+  :type 'integer
+  :group 'hashcash)
 
 (defcustom hashcash-payment-alist '()
   "*An association list mapping email addresses to payment amounts.
@@ -70,27 +72,39 @@ present, is the string to be hashed; if not present ADDR will be used."
                         (list :tag "Replace hash input"
                               (string :name "Address")
                               (string :name "Hash input")
-                              (integer :name "Amount")))))
+                              (integer :name "Amount"))))
+  :group 'hashcash)
 
 (defcustom hashcash-default-accept-payment 20
   "*The default minimum number of bits to accept on incoming payments."
-  :type 'integer)
+  :type 'integer
+  :group 'hashcash)
 
 (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.")
+is used instead."
+  :group 'hashcash)
 
 (defcustom hashcash-path (executable-find "hashcash")
-  "*The path to the hashcash binary.")
+  "*The path to the hashcash binary."
+  :group 'hashcash)
+
+(defcustom hashcash-extra-generate-parameters nil
+  "*A list of parameter strings passed to `hashcash-path' when minting.
+For example, you may want to set this to '(\"-Z2\") to reduce header length."
+  :type '(repeat string)
+  :group 'hashcash)
 
 (defcustom hashcash-double-spend-database "hashcash.db"
-  "*The path to the double-spending database.")
+  "*The path to the double-spending database."
+  :group 'hashcash)
 
 (defcustom hashcash-in-news nil
   "*Specifies whether or not hashcash payments should be made to newsgroups."
-  :type 'boolean)
+  :type 'boolean
+  :group 'hashcash)
 
 (defvar hashcash-process-alist nil
   "Alist of asynchronous hashcash processes and buffers.")
@@ -140,8 +154,9 @@ is used instead.")
       (save-excursion
        (set-buffer (get-buffer-create " *hashcash*"))
        (erase-buffer)
-       (call-process hashcash-path nil t nil
-                     "-m" "-q" "-b" (number-to-string val) str)
+       (apply 'call-process hashcash-path nil t nil
+              "-m" "-q" "-b" (number-to-string val) str
+              hashcash-extra-generate-parameters)
        (goto-char (point-min))
        (hashcash-token-substring))
     (error "No `hashcash' binary found")))
@@ -150,8 +165,10 @@ is used instead.")
   "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)))
+      (let ((process (apply 'start-process "hashcash" nil
+                           hashcash-path "-m" "-q"
+                           "-b" (number-to-string val) str
+                           hashcash-extra-generate-parameters)))
        (setq hashcash-process-alist (cons
                                      (cons process (current-buffer))
                                      hashcash-process-alist))
@@ -193,7 +210,8 @@ Return immediately.  Call CALLBACK with process and result when ready."
   (save-excursion
     (save-restriction
       (message-narrow-to-headers-or-head)
-      (let ((token (message-fetch-field "x-hashcash")))
+      (let ((token (message-fetch-field "x-hashcash"))
+           (case-fold-search t))
        (and (stringp token)
             (string-match (regexp-quote recipient) token))))))