diff options
Diffstat (limited to 'lisp/vm-crypto.el')
| -rwxr-xr-x | lisp/vm-crypto.el | 230 |
1 files changed, 230 insertions, 0 deletions
diff --git a/lisp/vm-crypto.el b/lisp/vm-crypto.el new file mode 100755 index 0000000..2213c3a --- /dev/null +++ b/lisp/vm-crypto.el @@ -0,0 +1,230 @@ +;;; vm-crypto.el --- Encryption and related functions for VM +;; +;; This file is part of VM +;; +;; Copyright (C) 2001 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'vm-crypto) + +(eval-when-compile + (require 'vm-misc) + (require 'vm-folder) + ) + +;; compatibility +(fset 'vm-pop-md5 'vm-md5-string) + +;;;###autoload +(defun vm-md5-region (start end) + (if (fboundp 'md5) + (md5 (current-buffer) start end) + (let ((buffer nil) + (retval nil) + (curbuf (current-buffer))) + (unwind-protect + (save-excursion + (setq buffer (vm-make-work-buffer)) + (set-buffer buffer) + (insert-buffer-substring curbuf start end) + ;; call-process-region calls write-region. + ;; don't let it do CR -> LF translation. + (setq selective-display nil) + (setq retval + (call-process-region (point-min) (point-max) + vm-pop-md5-program + t buffer nil)) + (if (not (equal retval 0)) + (progn + (error "%s failed: exited with code %s" + vm-pop-md5-program retval))) + ;; md5sum generates extra output even when summing stdin. + (goto-char (point-min)) + (if (re-search-forward " [ *]?-\n" nil t) + (replace-match "")) + + (goto-char (point-min)) + (if (or (re-search-forward "[^0-9a-f\n]" nil t) + (< (point-max) 32)) + (error "%s produced bogus MD5 digest '%s'" + vm-pop-md5-program + (vm-buffer-substring-no-properties (point-min) + (point-max)))) + ;; MD5 digest is 32 chars long + ;; mddriver adds a newline to make neaten output for tty + ;; viewing, make sure we leave it behind. + (vm-buffer-substring-no-properties (point-min) (+ (point-min) 32))) + (and buffer (kill-buffer buffer)))))) + +;; output is in hex +;;;###autoload +(defun vm-md5-string (string) + (if (fboundp 'md5) + (md5 string) + (vm-with-string-as-temp-buffer + string (function + (lambda () + (goto-char (point-min)) + (insert (vm-md5-region (point-min) (point-max))) + (delete-region (point) (point-max))))))) + +;; output is the raw digest bits, not hex +;;;###autoload +(defun vm-md5-raw-string (s) + (setq s (vm-md5-string s)) + (let ((raw (make-string 16 0)) + (i 0) n + (hex-digit-alist '((?0 . 0) (?1 . 1) (?2 . 2) (?3 . 3) + (?4 . 4) (?5 . 5) (?6 . 6) (?7 . 7) + (?8 . 8) (?9 . 9) (?A . 10) (?B . 11) + (?C . 12) (?D . 13) (?E . 14) (?F . 15) + ;; some mailer uses lower-case hex + ;; digits despite this being forbidden + ;; by the MIME spec. + (?a . 10) (?b . 11) (?c . 12) (?d . 13) + (?e . 14) (?f . 15)))) + (while (< i 32) + (setq n (+ (* (cdr (assoc (aref s i) hex-digit-alist)) 16) + (cdr (assoc (aref s (1+ i)) hex-digit-alist)))) + (aset raw (/ i 2) n) + (setq i (+ i 2))) + raw )) + +;;;###autoload +(defun vm-xor-string (s1 s2) + (let ((len (length s1)) + result (i 0)) + (if (/= len (length s2)) + (error "strings not of equal length")) + (setq result (make-string len 0)) + (while (< i len) + (aset result i (logxor (aref s1 i) (aref s2 i))) + (setq i (1+ i))) + result )) + +;;;###autoload +(defun vm-setup-ssh-tunnel (host port) + (let (local-port process done) + (while (not done) + (setq local-port (+ 1025 (random (- 65536 1025))) + process nil) + (condition-case nil + (progn + (setq process + (open-network-stream "TEST-CONNECTION" nil + "127.0.0.1" local-port)) + (vm-process-kill-without-query process)) + (error nil)) + (cond ((null process) + (setq process + (apply 'start-process + (format "SSH tunnel to %s:%s" host port) + (vm-make-work-buffer) + vm-ssh-program + (nconc + (list "-L" + (format "%d:%s:%s" local-port host port)) + (copy-sequence vm-ssh-program-switches) + (list host vm-ssh-remote-command))) + done t) + (vm-process-kill-without-query process) + (set-process-sentinel process 'vm-process-sentinel-kill-buffer)) + (t + (delete-process process)))) + + ;; wait for some output from vm-ssh-remote-command. this + ;; ensures that when we return the ssh connection is ready to + ;; do port-forwarding. + (accept-process-output process) + + local-port )) + +(defun vm-generate-random-data-file (n-octets) + (let ((file (vm-make-tempfile)) + work-buffer (i n-octets)) + (unwind-protect + (save-excursion + (setq work-buffer (vm-make-work-buffer)) + (set-buffer work-buffer) + (while (> i 0) + (insert-char (random 256) 1) + (setq i (1- i))) + (write-region (point-min) (point-max) file nil 0)) + (and work-buffer (kill-buffer work-buffer))) + file )) + +;;;###autoload +(defun vm-setup-stunnel-random-data-if-needed () + (cond ((null vm-stunnel-random-data-method) nil) + ((eq vm-stunnel-random-data-method 'generate) + (if (and (stringp vm-stunnel-random-data-file) + (file-readable-p vm-stunnel-random-data-file)) + nil + (setq vm-stunnel-random-data-file + (vm-generate-random-data-file (* 4 1024))))))) + +;;;###autoload +(defun vm-tear-down-stunnel-random-data () + (if (stringp vm-stunnel-random-data-file) + (vm-error-free-call 'delete-file vm-stunnel-random-data-file)) + (setq vm-stunnel-random-data-file nil)) + +(defun vm-stunnel-random-data-args () + (cond ((null vm-stunnel-random-data-method) nil) + ((eq vm-stunnel-random-data-method 'generate) + (list "-R" vm-stunnel-random-data-file)) + (t nil))) + +;;;###autoload +(defun vm-stunnel-configuration-args (host port) + (if (eq vm-stunnel-wants-configuration-file 'unknown) + (setq vm-stunnel-wants-configuration-file + (not (eq (call-process vm-stunnel-program nil nil nil "-h") 0)))) + (if (not vm-stunnel-wants-configuration-file) + (nconc (vm-stunnel-random-data-args) + (list "-W" "-c" "-r" + (format "%s:%s" host port))) + (let ((work-buffer nil) + (workfile (vm-stunnel-configuration-file))) + (unwind-protect + (save-excursion + (setq work-buffer (vm-make-work-buffer)) + (set-buffer work-buffer) + (if (and vm-stunnel-program-additional-configuration-file + (stringp vm-stunnel-program-additional-configuration-file) + (file-readable-p + vm-stunnel-program-additional-configuration-file)) + (insert-file-contents + vm-stunnel-program-additional-configuration-file)) + (insert "client = yes\n") + (insert "RNDfile = " vm-stunnel-random-data-file "\n") + (insert "RNDoverwrite = no\n") + (insert "connect = " (format "%s:%s" host port) "\n") + (write-region (point-min) (point-max) workfile nil 0)) + (and work-buffer (kill-buffer work-buffer))) + (list workfile) ))) + +(defun vm-stunnel-configuration-file () + (if vm-stunnel-configuration-file + vm-stunnel-configuration-file + (setq vm-stunnel-configuration-file (vm-make-tempfile)) + (vm-register-global-garbage-files (list vm-stunnel-configuration-file)) + vm-stunnel-configuration-file)) + +;;; vm-crypto.el ends here |