;;; hashcash.el --- Add hashcash payments to email
-;; $Revision: 1.1.1.2 $
-;; Copyright (C) 1997,2001 Paul E. Foley
+;; $Revision: 1.1.1.3 $
+;; 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:
;;; Code:
+(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.
"*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"
(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))
(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"
(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)
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
projects / elisp / gnus.git- / blobdiff