[Mew-dist 11808] SSH support

[hideyuki at example.com]

鈴木＠東大計数と申します。

Mew が直接 SMTP をしゃべるようになったので，IM でサポートしていた
SSH の port forwarding 機能が利用できなくなってしまいました。
そこで，SSH を Mew から起動してメールの送信に SSH を利用できる
ようにしてみました。mew-1.95b12 の mew-smtp.el へのパッチを添付します。

つたない elisp ですが，私のところでは一応動いています。
私は elisp の書き方がよくわかっていないので，
変なところを指摘して/直してもらえると嬉しいです。

使うには，以下のように mew-ssh-server を設定します。
  (setq mew-ssh-server "<SSH中継サーバ名>")
これで mew-smtp-server に SSH 経由で接続するようになります。

SSH の port forwarding の入口の local port 番号は
  (setq mew-ssh-local-port <port 番号>)
で指定します。指定がなかったときのデフォルトは 8025 です。
IM と同様，空いているポートをいくつか探すようになっています。
-- 
Hideyuki Suzuki <hideyuki at example.com>
Department of Mathematical Engineering, the University of Tokyo
-------------- next part --------------
Index: mew-smtp.el
===================================================================
RCS file: /home/maple/hideyuki/lib/CVSROOT/src/mew/mew-smtp.el,v
retrieving revision 1.1.1.2
retrieving revision 1.10
diff -u -r1.1.1.2 -r1.10
--- mew-smtp.el	1999/12/13 11:32:52	1.1.1.2
+++ mew-smtp.el	1999/12/13 17:44:42	1.10
@@ -11,6 +11,7 @@
 (require 'mew)
 
 (defvar mew-smtp-server "localhost")
+(defvar mew-smtp-server-port 25)
 (defvar mew-smtp-keep-connection nil
   "*If non-nil. SMTP connection is maintained for further SMTP
 sessions. Otherwise, SMTP connection is closed after SMTP
@@ -26,6 +27,15 @@
 (defvar mew-smtp-error nil)
 (defvar mew-smtp-lock nil)
 
+(defvar mew-prog-ssh "ssh")
+(defvar mew-ssh-server nil)
+(defvar mew-ssh-local-port 8025)
+(defvar mew-ssh-sleep-time 300)
+(defvar mew-ssh-timeout-time 20)
+
+(defvar mew-ssh-process nil)
+(defvar mew-ssh-status nil)
+
 (defvar mew-smtp-fsm
   '(("greeting" "220" "helo")
     ("helo" "250" "mail-from")
@@ -48,10 +58,49 @@
       (save-excursion
 	(set-buffer (get-buffer-create "*Mew debug*"))
 	(insert (format "\n<%s>\n%s\n" label string)))))
+
+(defun mew-ssh-proxy (ssh-server local-port server port)
+  (message "Establishing SSH connection to %s ..." ssh-server)
+  (let ((process-connection-type mew-connection-type1) (i -1))
+    (while (or (< i 0)
+	       (and (< i 2)
+		    (string= mew-ssh-status "port_in_use")))
+      (setq i (1+ i))
+      (setq mew-ssh-status nil)
+      (if (processp mew-ssh-process)
+	  (delete-process mew-ssh-process))
+      (setq mew-ssh-process
+	    (start-process "ssh" nil
+			   mew-prog-ssh "-n" "-x" "-o" "BatchMode yes"
+			   (format "-L%d:%s:%d" (+ local-port i) server port)
+			   ssh-server
+			   (format "echo ssh_proxy_connect ; sleep %d"
+				   mew-ssh-sleep-time)))
+      (if mew-ssh-process
+	  (progn
+	    (set-process-filter mew-ssh-process 'mew-ssh-filter)
+	    (accept-process-output mew-ssh-process mew-ssh-timeout-time))))
+  (cond
+   ((string= mew-ssh-status "connected")
+    (message "Establishing SSH connection to %s ... done" ssh-server)
+    (+ local-port i))
+   (t
+    (if (processp mew-ssh-process)
+	(delete-process mew-ssh-process))
+    (setq mew-ssh-process nil)
+    (message "Establishing SSH connection to %s ... failed" ssh-server)
+    nil))))
+
+(defun mew-ssh-filter (process string)
+  (cond
+   ((string-match "ssh_proxy_connect" string)
+    (setq mew-ssh-status "connected"))
+   ((string-match "Local: bind: Address already in use" string)
+    (setq mew-ssh-status "port_in_use"))))
 
-(defun mew-smtp-open (server)
+(defun mew-smtp-open (server port)
   (setq mew-smtp-error nil)
-  (let ((port "smtp") pro tm)
+  (let (pro tm)
     (condition-case emsg
 	(progn
 	  (setq tm (mew-timer mew-smtp-timeout-time 'mew-smtp-timeout))
@@ -80,7 +129,7 @@
   (signal 'quit nil))
 
 (defun mew-smtp-send-message (&optional unlock)
-  (let ((ret t) opened)
+  (let ((ret t) opened local-port)
     (cond
      ((null mew-draft-recipients)
       (setq ret nil)
@@ -102,7 +151,17 @@
 	(mew-smtp-filter-helo mew-smtp-process)
 	(message "Sending in background ... "))
        (t
-	(setq mew-smtp-process (mew-smtp-open mew-smtp-server))
+	(if (null mew-ssh-server)
+	    (setq mew-smtp-process
+		  (mew-smtp-open mew-smtp-server mew-smtp-server-port))
+	  (setq local-port
+		(mew-ssh-proxy mew-ssh-server mew-ssh-local-port
+			       mew-smtp-server mew-smtp-server-port))
+	  (setq mew-smtp-process
+		(if local-port
+		    (mew-smtp-open "localhost" local-port)
+		  (setq mew-smtp-error "can't make SSH connection")
+		  nil)))
 	(if (null mew-smtp-process)
 	    (mew-smtp-queue mew-smtp-error)
 	  (setq mew-smtp-status "greeting")
@@ -261,6 +320,9 @@
   (setq mew-smtp-messages nil)
   (setq mew-smtp-error nil)
   (setq mew-smtp-lock nil)
+  (if (processp mew-ssh-process)
+      (delete-process mew-ssh-process))
+  (setq mew-ssh-process nil)
   (remove-hook 'kill-emacs-hook (function mew-smtp-kill-emacs-hook)))
 
 ;;;