home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 3 / 3323 / md4.el
Encoding:
Text File  |  1991-05-12  |  3.9 KB  |  138 lines
  1. ;; @(#)@ md4 1.1 - MD4 support for GNUS
  2. ;;
  3. ;; This file defines functions to calculate a MD4 signature, add
  4. ;; it to outgoing postings, and validate it on incoming postings.
  5. ;;
  6. ;; It uses "gnus-Inews-article-hook", called by GNUS just before passing
  7. ;; the articel to inews, to install the signature.
  8. ;;
  9. ;; "gnus-Article-prepare-hook" is used to validate the signature on
  10. ;; an article if you read it.
  11. ;;
  12. ;; This file, if useful, is covered by the GPL.
  13. ;;
  14. ;;    Johan Vromans <jv@mh.nl>
  15.  
  16. ;; Customizations
  17.  
  18. (defvar md4-command "md4" "*Where to find md4")
  19.  
  20. (defvar md4-signature-header "X-Md4-Signature")
  21.  
  22. (defvar md4-insertion t
  23.   "*Controls MD4 signature insertion. If nil, no signature is
  24.   calculated nor inserted.")
  25.  
  26. (defvar md4-validation 1
  27.   "*Controls MD4 signature validation. If nil, no validation is
  28.   performed. If t, validation is performed, and failures are reported.
  29.   Any other value causes validation to be performed, and failures as
  30.   well as successes to be reported.")
  31.  
  32. ;; Hook definitions and insertions.
  33.  
  34. (add-hook 'gnus-Inews-article-hook 'md4-add-signature)
  35. (add-hook 'gnus-Article-prepare-hook 'md4-validate-signature)
  36. ;;
  37. ;; Calcuates the MD4 signature for the article to be posted, which
  38. ;; is assumed to be in the current buffer.
  39. ;;
  40. (defun md4-add-signature ()
  41.   "Adds a MD4-signature to the article being posted. Must be called
  42. from gnus-Inews-article-hook."
  43.   (interactive)
  44.  
  45.   (if (null md4-insertion)
  46.       nil
  47.     (let (start-of-body end-of-body sigfile)
  48.  
  49.       ;; .signature handling. may be system specific
  50.       (goto-char (point-max))
  51.       (setq end-of-body (point-marker))
  52.       (if (file-exists-p
  53.        (setq sigfile
  54.          (or gnus-signature-file (expand-file-name "~/.signature"))))
  55.       (progn
  56.         (insert "-- \n")        ; that is what I get inserted...
  57.         (insert-file sigfile))
  58.     (setq sigfile nil))
  59.  
  60.       (goto-char (point-min))
  61.       (search-forward "\n\n")
  62.       (setq start-of-body (point-marker))    ; remember where
  63.       
  64.       ;; Run md4 and add the signature.
  65.       (forward-line -1)
  66.       (insert md4-signature-header ": ")
  67.       (insert (md4-signature-region start-of-body (point-max)))
  68.       (insert "\n")
  69.  
  70.       (if sigfile
  71.       (delete-region end-of-body (point-max)))
  72.       )))
  73.  
  74. ;;
  75. ;; Validate MD4 signature. A message is shown with the result.
  76. ;; If the signature does not match, buffer "*MD4 Buffer*" holds more
  77. ;; information.
  78. ;;
  79. (defun md4-validate-signature ()
  80.   "Checks a MD4-signature in the article being read. May be called
  81. from gnus-article-prepare-hook."
  82.   (interactive)
  83.  
  84.   (if (null md4-validation)
  85.       nil
  86.     (let (start-of-body)
  87.       (goto-char (point-min))
  88.       (search-forward "\n\n")
  89.       (setq start-of-body (point-marker))    ; remember where
  90.  
  91.       ;; Check if a signature header is present
  92.       (goto-char (point-min))
  93.       (if (search-forward 
  94.        (concat "\n" md4-signature-header ": ")
  95.        start-of-body t)
  96.       (let (signature (here (point)))
  97.         (forward-line 1)
  98.         (setq signature (buffer-substring here (1- (point))))
  99.  
  100.         ;; Validate
  101.         (if (string= 
  102.          signature
  103.          (md4-signature-region start-of-body (point-max)))
  104.         (progn
  105.           (if (not (equal md4-validation t))
  106.               (message "MD4 signature valid."))
  107.           (bury-buffer md4-buffer))
  108.           (beep)
  109.           (save-excursion
  110.         (set-buffer md4-buffer)
  111.         (goto-char (point-min))
  112.         (insert (message "MD4 signature mismatch!")
  113.             "\nPosted:     " signature
  114.             "\nCalculated: ")
  115.         (goto-char (point-min))))
  116.         )))))
  117.  
  118. (defun md4-signature-region (start end)
  119.   "Calculates MD4 signature."
  120.  
  121.   ;; Get buffer and clear it
  122.   (setq md4-buffer (get-buffer-create "*MD4 Buffer*"))
  123.   (save-excursion
  124.     (set-buffer md4-buffer)
  125.     (erase-buffer))
  126.  
  127.   ;; Run md4
  128.   (call-process-region start end
  129.                md4-command nil md4-buffer nil)
  130.  
  131.   ;; Verify normal result
  132.   (save-excursion
  133.     (set-buffer md4-buffer)
  134.     (if (= (buffer-size) 33)
  135.     (buffer-substring (point-min) (1- (point-max)))
  136.       (error "Unexpected result from %s: %s" md4-command
  137.          (buffer-substring (point-min) (point-max))))))
  138.