git.chise.org Git - elisp/gnus.git-/blob - lisp/read-passwd.el

   1 ;; read-passwd.el.el --- Read password function for Pterodactyl Gnus.
   2 ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. , Tatsuya Ichikawa
   3 ;; Author: Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
   4 ;; Version: 0.01
   5 ;; Keywords: mail , gnus , pop3 , password
   6 ;;
   7 ;; SPECIAL THANKS
   8 ;;    Katsumi Yamaoka <yamaoka@jpl.org>
   9 ;;
  10 ;; This file is part of Semi-gnus.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26 ;;
  27 ;;
  28 (require 'mail-source)
  29
  30 (defun read-pw-read-passwd (prompt)
  31   (read-pw-read-noecho prompt t))
  32 ;;
  33 (defmacro read-pw-read-char-exclusive ()
  34   (cond ((featurep 'xemacs)
  35          '(let ((table (quote ((backspace . ?\C-h) (delete . ?\C-?)
  36                                (left . ?\C-h))))
  37                 event key)
  38             (while (not
  39                     (and
  40                      (key-press-event-p (setq event (next-command-event)))
  41                      (setq key (or (event-to-character event)
  42                                    (cdr (assq (event-key event) table)))))))
  43             key))
  44         ((fboundp 'read-char-exclusive)
  45          '(read-char-exclusive))
  46         (t
  47          '(read-char))))
  48 ;;
  49 (defun read-pw-read-noecho (prompt &optional stars)
  50   "Read a single line of text from user without echoing, and return it.
  51 Argument PROMPT ."
  52   (let ((ans "")
  53         (c 0)
  54         (echo-keystrokes 0)
  55         (cursor-in-echo-area t)
  56         (log-message-max-size 0)
  57         message-log-max done msg truncate)
  58     (while (not done)
  59       (if (or (not stars) (string-equal "" ans))
  60           (setq msg prompt)
  61         (setq msg (concat prompt (make-string (length ans) ?*)))
  62         (setq truncate
  63               (1+ (- (length msg) (window-width (minibuffer-window)))))
  64         (and (> truncate 0)
  65              (setq msg (concat "$" (substring msg (1+ truncate))))))
  66       (message msg)
  67       (setq c (read-pw-read-char-exclusive))
  68       (cond ((eq ?\C-g c)
  69              (setq quit-flag t
  70                    done t))
  71             ((memq c '(?\r ?\n ?\e))
  72              (setq done t))
  73             ((eq ?\C-u c)
  74              (setq ans ""))
  75             ((and (/= ?\b c) (/= ?\177 c))
  76              (setq ans (concat ans (char-to-string c))))
  77             ((> (length ans) 0)
  78              (setq ans (substring ans 0 -1)))))
  79     (if quit-flag
  80         (prog1
  81             (setq quit-flag nil)
  82           (message "Quit")
  83           (beep t))
  84       (message "")
  85       ans)))
  86 ;;
  87 (defvar pw nil)
  88 (defun read-pw-set-mail-source-passwd-cache ()
  89   (car (mapcar
  90         (lambda (x)
  91           (mail-source-bind (pop x)
  92             (let ((from (format "%s:%s:%s" server user port))
  93                   (mail-source-string (format "%s:%s@%s" (car x) user server)))
  94               (setq pw (read-pw-return-passwd-string user server))
  95               (unless (assoc user mail-source-password-cache)
  96                 (set-alist 'mail-source-password-cache
  97                            (format "%s:%s:%s" server user port)
  98                            pw))
  99               (cdr (assoc from mail-source-password-cache)))))
 100 ;;      gnus-offline-mail-source)))
 101         nnmail-spool-file)))
 102 ;;
 103 ;;
 104 (defvar passwd nil)
 105 (defun read-pw-return-passwd-string (user server)
 106   (setq passwd (read-pw-read-passwd
 107                 (message "POP Password for %s at %s : " user server)))
 108   passwd)
 109 ;;
 110 (provide 'read-passwd)