From 3e15555f9d5f1ac18094ac12b4a17dba741f9173 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 12 Oct 1995 22:45:41 +0000
Subject: [PATCH] Change to support (FILE <filename>) password option for POP
 mail. Also add support for Debian popclient program, which has different
 argument options than regular popclient.

---
 v7/src/edwin/unix.scm | 95 +++++++++++++++++++++++++++++++------------
 1 file changed, 69 insertions(+), 26 deletions(-)

diff --git a/v7/src/edwin/unix.scm b/v7/src/edwin/unix.scm
index 61c8a7a3a..f484db30f 100644
--- a/v7/src/edwin/unix.scm
+++ b/v7/src/edwin/unix.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: unix.scm,v 1.57 1995/10/03 21:12:37 cph Exp $
+;;;	$Id: unix.scm,v 1.58 1995/10/12 22:45:41 cph Exp $
 ;;;
 ;;;	Copyright (c) 1989-95 Massachusetts Institute of Technology
 ;;;
@@ -673,20 +673,21 @@ Value is a list of strings."
     (let ((start (skip-chars-backward chars point start)))
       (make-region start (skip-chars-forward chars start end)))))
 
-(define (os/scheme-can-quit?)
-  (subprocess-job-control-available?))
-
-(define (os/quit dir)
-  dir					; ignored
-  (%quit))
+;;;; POP Mail
 
-(define (os/set-file-modes-writable! pathname)
-  (set-file-modes! pathname #o777))
+(define-variable rmail-pop-delete
+  "If true, messages are deleted from the POP server after being retrieved.
+Otherwise, messages remain on the server and will be re-fetched later."
+  #t
+  boolean?)
 
-(define (os/sendmail-program)
-  (if (file-exists? "/usr/lib/sendmail")
-      "/usr/lib/sendmail"
-      "fakemail"))
+(define-variable rmail-popclient-is-debian
+  "If true, the popclient running on this machine is Debian popclient.
+Otherwise, it is the standard popclient.  Debian popclient differs from
+standard popclient in that it does not accept the -p <password>
+option, instead taking -P <filename>."
+  #f
+  boolean?)
 
 (define (os/rmail-pop-procedure)
   (and (unix/find-program "popclient" (ref-variable exec-path) #f)
@@ -697,14 +698,18 @@ Value is a list of strings."
   (let ((target (->namestring (merge-pathnames ".popmail" directory))))
     (let ((buffer (temporary-buffer "*popclient*")))
       (let ((status.reason
-	     (let ((args
-		    (list "-u" user-name "-p" password "-o" target server)))
-	       (apply run-synchronous-process #f (buffer-end buffer) #f #f
-		      "popclient"
-		      "-3"
-		      (if (ref-variable rmail-pop-delete)
-			  args
-			  (cons "-k" args))))))
+	     (unix/call-with-pop-client-password-options password
+	       (lambda (password-options)
+		 (let ((args
+			(append (list "-u" user-name)
+				password-options
+				(list "-o" target server))))
+		   (apply run-synchronous-process #f (buffer-end buffer) #f #f
+			  "popclient"
+			  "-3"
+			  (if (ref-variable rmail-pop-delete)
+			      args
+			      (cons "-k" args))))))))
 	(if (and (eq? 'EXITED (car status.reason))
 		 (memv (cdr status.reason) '(0 1)))
 	    (kill-buffer buffer)
@@ -713,11 +718,49 @@ Value is a list of strings."
 	      (editor-error "Error getting mail from POP server.")))))
     target))
 
-(define-variable rmail-pop-delete
-  "If true, messages are deleted from the POP server after being retrieved.
-Otherwise, messages remain on the server and will be re-fetched later."
-  #t
-  boolean?)
+(define (unix/call-with-pop-client-password-options password receiver)
+  (if (ref-variable rmail-popclient-is-debian)
+      (cond ((string? password)
+	     (call-with-temporary-filename
+	      (lambda (temporary-file)
+		(set-file-modes! temporary-file #o600)
+		(call-with-output-file temporary-file
+		  (lambda (port)
+		    (write-string password port)
+		    (newline port)))
+		(receiver (list "-P" filename)))))
+	    ((and (pair? password) (eq? 'FILE (car password)))
+	     (receiver
+	      (list "-P" (->namestring (merge-pathnames (cadr password))))))
+	    (else
+	     (error "Illegal password:" password)))
+      (cond ((string? password)
+	     (receiver (list "-p" password)))
+	    ((and (pair? password) (eq? 'FILE (car password)))
+	     (receiver
+	      (list "-p"
+		    (call-with-input-file (cadr password)
+		      (lambda (port)
+			(read-string (char-set #\newline) port))))))
+	    (else
+	     (error "Illegal password:" password)))))
+
+;;;; Miscellaneous
+
+(define (os/scheme-can-quit?)
+  (subprocess-job-control-available?))
+
+(define (os/quit dir)
+  dir					; ignored
+  (%quit))
+
+(define (os/set-file-modes-writable! pathname)
+  (set-file-modes! pathname #o777))
+
+(define (os/sendmail-program)
+  (if (file-exists? "/usr/lib/sendmail")
+      "/usr/lib/sendmail"
+      "fakemail"))
 
 (define os/hostname
   (ucode-primitive full-hostname 0))
-- 
2.25.1