;;; hashcash.el --- Add hashcash payments to email ;; Copyright (C) 1997 Paul E. Foley ;; Maintainer: Paul Foley <mycroft@actrix.gen.nz> ;; Keywords: mail, hashcash ;; Released under the GNU General Public License (defvar hashcash-default-payment 12) (defvar hashcash-payment-alist nil) (defvar hashcash "/home/paul/bin/hashcash") (require 'mail-utils) (defun hashcash-generate-payment (str val) "Generate a hashcash payment by finding a VAL-bit collison on STR." (let ((old-buffer (current-buffer)) (hc (get-buffer-create "*hashcash*")) pos) (set-buffer hc) (erase-buffer) (goto-char (point-max)) (call-process hashcash nil hc nil (concat "-" val) str) (goto-char (point-max)) (re-search-backward "collision: ") (forward-char 11) (setq pos (point-marker)) (end-of-line) (setq payment (buffer-substring pos (point))) (set-buffer old-buffer)) (concat payment "\n")) (defun mail-add-payment (arg) "Add an X-Payment: header with a hashcash payment for each recipient address Prefix arg means non-default payment amount. Also uses hashcash-payment-alist." (interactive "P") (unwind-protect (save-excursion (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n")) (previous-line 1) (let ((end (point-marker)) (case-fold-search t)) (goto-char (point-min)) (while (re-search-forward "^\\(to\\|cc\\):" end t) (let ((to-line (mail-strip-quoted-names (buffer-substring (point) (progn (if (re-search-forward "^[^ \t\n]" end t) (backward-char 1) (goto-char end)) (point)))))) (while (not (equal "" to-line)) (let ((address (substring to-line 0 (string-match "," to-line)))) (if (string-match "," to-line) (setq to-line (substring to-line (string-match "," to-line))) (setq to-line "")) (while (eq 0 (string-match "[, \t]" to-line)) (setq to-line (substring to-line 1))) ;; look up hashcash-payment-alist (let ((pay (assoc address hashcash-payment-alist)) (price (if (null arg) hashcash-default-payment (prefix-numeric-value arg)))) (if pay (if (eq 1 (length (cdr pay))) (setq price (car (cdr pay))) (progn (setq address (car (cdr pay))) (setq price (car (cdr (cdr pay))))))) (insert-before-markers "X-Payment: " (hashcash-generate-payment address price))))))))))) -- Paul Foley <mycroft@actrix.gen.nz> --- PGP-encrypted mail preferred PGP key ID 0x1CA3386D available from keyservers fingerprint = 4A 76 83 D8 99 BC ED 33 C5 02 81 C9 BF 7A 91 E8 ---------------------------------------------------------------------- Note: All email will be directed to my "junk" mailbox unless a 12-bit hashcash payment is attached on an X-Payment: header. Send me mail with the subject "get hashcash info" for information. ---------------------------------------------------------------------- If there is a possibility of several things going wrong, the one that will cause the most damage will be the one to go wrong.