+2000-09-01 Daiki Ueno <ueno@unixuser.org>
+
+ * liece-crypt.el: Remove.
+
+ * liece-400.el (liece-handle-433-message): Use `liece-beep'
+ (liece-handle-432-message): Ditto.
+
+ * liece-misc.el (liece-beep): New macro.
+ (liece-set-beep): Rename from `liece-beep'.
+
+ * liece-xemacs.el (liece-xemacs-channel-balloon): Abolish local
+ variable `chnl'.
+
+ * liece.el: Don't require `liece-crypt'.
+ (liece-crypt-map): Abolish.
+ (liece-buffer-mode-alist): Remove `liece-CRYPT-buffer'.
+ (liece-command-mode-map): Don't bind
+ `liece-command-enter-message-opposite-crypt-mode'.
+ (liece): Don't initialize crypt indicator.
+ (liece-command-mode): Ditto.
+ (liece-dialogue-mode): Ditto.
+ (liece-channel-mode): Ditto.
+
+ * liece-xemacs.el: Don't require `liece-crypt'.
+ (liece-toolbar-crypt-active-icon): Abolish.
+ (liece-toolbar-crypt-inactive-icon): Abolish.
+ (liece-toolbar-crypt-icon): Abolish.
+ (liece-toolbar-crypt-glyph): Abolish.
+ (liece-toolbar-crypt-active-glyph): Abolish.
+ (liece-toolbar-crypt-inactive-glyph): Abolish.
+ (liece-toolbar-spec-list): Don't set `liece-toolbar-crypt-glyph'.
+ (liece-xemacs-setup-toolbar-hook): Remove `liece-toolbar-setup-crypt-glyph'.
+ (liece-toolbar-setup-crypt-glyph): Abolish.
+ (liece-toolbar-toggle-crypt): Abolish.
+
+ * liece-vars.el (liece-defected-message-prefix): Abolish.
+ (liece-suspicious-message-prefix): Abolish.
+ (liece-beep-function): New variable.
+
+ * liece-message.el (liece-message-brackets-function): Don't handle
+ `liece-message-encrypted-p'.
+ (liece-message-encrypted-p): Abolish.
+ (liece-message-suspicious-p): Abolish.
+ (liece-message-garbled-p): Abolish.
+ (liece-message-fingerprint): Abolish.
+ (liece-message-timestamp): Abolish.
+
+ * liece-menu.el (liece-menu-crypt-menu): Abolish.
+ (liece-menu-channel-menu): Remove `liece-menu-crypt-menu'.
+ (liece-menu-alist): Ditto.
+ (liece-menu-crypt-menu-map): Abolish.
+
+ * liece-handle.el (liece-handle-notice-message): Don't use
+ `with-liece-decryption'.
+ (liece-handle-privmsg-message): Ditto.
+ Use `liece-beep' instead of `beep'.
+
+ * liece-modules.el (liece-modules-to-compile): Remove `liece-crypt'.
+
+ * liece-globals.el (liece-crypt-indicator): Abolish.
+ (liece-CRYPT-buffer): Abolish.
+ (liece-C-buffer): Abolish.
+
+ * liece-commands.el: Don't require `liece-crypt'.
+ (liece-command-send-message): Abolish optional argument ARG and KEY.
+ (liece-command-enter-message): Ditto.
+ (liece-command-message): Ditto.
+ (liece-enter-message): Abolish.
+ (liece-command-part): Don't set crypt indicator.
+ (liece-switch-to-channel): Ditto.
+ (liece-switch-to-channel-no): Ditto.
+ (liece-command-private-conversation): Ditto.
+ (liece-command-toggle-crypt): Abolish.
+
2000-08-31 Akira Ohashi <bg66@luck.gr.jp>
* liece-handle.el (liece-handle-privmsg-message): Fixed.
(liece-message
(_ "Erroneous nickname %s. Choose a new one with %s.")
nick (substitute-command-keys "\\[liece-command-nickname]"))
- (beep))))
+ (liece-beep))))
(defun liece-handle-433-message (prefix rest)
"ERR_NICKNAMEINUSE \"<nickname> :Nickname is already in use\"."
(liece-message
(_ "Nickname %s already in use. Choose a new one with %s.")
nick (substitute-command-keys "\\[liece-command-nickname]"))
- (beep))))))
+ (liece-beep))))))
(defun liece-handle-442-message (prefix rest)
"ERR_NOTONCHANNEL \"<channel> :You're not on that channel\"."
;;; Code:
(eval-when-compile
- (require 'liece-crypt)
(require 'liece-misc))
(require 'liece-channel)
(let ((win (liece-get-buffer-window liece-command-buffer)))
(if win (select-window win))))
-(defun liece-command-send-message
- (message &optional arg key)
- "Send MESSAGE to current chat partner of current channel.
-If argument ARG is non-nil message will be encrypted with KEY."
- (when arg
- (setq liece-crypt-mode-active (not liece-crypt-mode-active)))
+(defun liece-command-send-message (message)
+ "Send MESSAGE to current chat partner of current channel."
(if (string-equal message "")
(progn (liece-message (_ "No text to send")) nil)
(let ((addr (if (eq liece-command-buffer-mode 'chat)
liece-current-chat-partner
liece-current-channel))
- repr method name target
- (msg message))
- (with-liece-encryption (msg addr arg key)
- (cond
- ((eq liece-command-buffer-mode 'chat)
- (if (null liece-current-chat-partner)
- (message
- (substitute-command-keys
- "Type \\[liece-command-join] to start private conversation"))
- (setq repr (liece-channel-parse-representation
- liece-current-chat-partner)
- method (aref repr 0)
- name (aref repr 1)
- target (aref repr 2))
- (cond ((eq method 'dcc)
- (liece-dcc-chat-send target msg))
- ((eq method 'irc)
- (liece-send "PRIVMSG %s :%s"
- liece-current-chat-partner msg)))
- (liece-own-private-message message)))
- ((not liece-current-channel)
- (beep t)
- (message (substitute-command-keys
- "Type \\[liece-command-join] to join a channel")))
- (t
- (liece-send
- "PRIVMSG %s :%s"
- (liece-channel-real liece-current-channel) msg)
- (liece-own-channel-message message))))
- t)))
-
-(defun liece-enter-message (&optional arg key)
- "Enter the current line as an entry in the IRC dialogue.
-If argument ARG is non-nil message will be encrypted with KEY."
+ repr method name target)
+ (cond
+ ((eq liece-command-buffer-mode 'chat)
+ (or liece-current-chat-partner
+ (error
+ (substitute-command-keys
+ "Type \\[liece-command-join] to start private conversation")))
+ (setq repr (liece-channel-parse-representation
+ liece-current-chat-partner)
+ method (aref repr 0)
+ name (aref repr 1)
+ target (aref repr 2))
+ (cond ((eq method 'dcc)
+ (liece-dcc-chat-send target message))
+ ((eq method 'irc)
+ (liece-send "PRIVMSG %s :%s"
+ liece-current-chat-partner message)))
+ (liece-own-private-message message))
+ (t
+ (or liece-current-channel
+ (error
+ (substitute-command-keys
+ "Type \\[liece-command-join] to join a channel")))
+ (liece-send
+ "PRIVMSG %s :%s"
+ (liece-channel-real liece-current-channel) message)
+ (liece-own-channel-message message))))))
+
+(defun liece-command-enter-message ()
+ "Enter the current line as an entry in the IRC dialogue."
+ (interactive)
(beginning-of-line)
- (if (liece-command-send-message
- (buffer-substring (point)(progn (end-of-line) (point)))
- arg key)
- (liece-next-line 1)))
-
-(defun liece-command-enter-message (&optional arg key)
- "Enter the current line as an entry in the IRC dialogue.
-If the prefix argument ARG is non-nil, message will be encrypted with KEY."
- (interactive
- (let ((completion-ignore-case t))
- (and (if current-prefix-arg
- (not liece-crypt-mode-active)
- liece-crypt-mode-active)
- (list
- 'encrypt
- (completing-read
- (_ "Encrypt message with key [RET for none]: ")
- (cons (cons "" nil)
- liece-crypt-encryption-keys))))))
- (liece-enter-message arg (if (string-equal key "") nil key)))
+ (liece-command-send-message
+ (buffer-substring (point)(progn (end-of-line) (point))))
+ (liece-next-line 1))
(defun liece-dialogue-enter-message ()
"Ask for a line as an entry in the IRC dialogue on the current channel."
liece-current-chat-partner
(car liece-current-chat-partners))
(liece-set-channel-indicator)
- (liece-set-crypt-indicator)
(liece-channel-part part-channel-var))))
(defun liece-command-kill (kill-nickname-var &optional timeout silent)
(string-times "v" (length vcs))
(string-join vcs " ")))))
-(defun liece-command-message (address message &optional arg key)
- "Send ADDRESS a private MESSAGE.
-If argument ARG is non-nil message will be encrypted with KEY."
+(defun liece-command-message (address message)
+ "Send ADDRESS a private MESSAGE."
(interactive
(let ((completion-ignore-case t) address)
(setq address
(read-string
(format
(_ "Private message to %s: ")
- address))
- (if current-prefix-arg
- (not liece-crypt-mode-active)
- liece-crypt-mode-active)
- nil)))
+ address)))))
(if (funcall liece-message-empty-predicate message)
(progn (liece-message (_ "No text to send")) nil)
- (let ((chnl (liece-channel-real address)) (msg message))
- (with-liece-encryption (msg address arg key)
- (liece-send "PRIVMSG %s :%s" chnl msg)
- (if (liece-channel-p chnl)
- (liece-own-channel-message message
- (liece-channel-virtual address))
- (liece-own-private-message message address)))
- t)))
-
-;; Added at mta@tut.fi's request...
-;; Does not support encryption (yet!?)
+ (let ((chnl (liece-channel-real address)))
+ (liece-send "PRIVMSG %s :%s" chnl message)
+ (if (liece-channel-p chnl)
+ (liece-own-channel-message message
+ (liece-channel-virtual address))
+ (liece-own-private-message message address)))))
(defun liece-command-mta-private (partner)
"Send a private message (current line) to PARTNER."
(end-of-buffer
(message "End of buffer"))))))
-(defun liece-command-toggle-crypt (&optional arg)
- "Toggle crypt status.
-If prefix argument ARG is non-nil, force set crypt status."
- (interactive "P")
- (if arg
- (setq liece-crypt-mode-active (prefix-numeric-value arg))
- (if liece-crypt-mode-active
- (setq liece-crypt-mode-active nil)
- (setq liece-crypt-mode-active t)))
- (liece-set-crypt-indicator)
- (switch-to-buffer (current-buffer)))
-
(defun liece-command-freeze (&optional arg)
"Prevent automatic scrolling of the dialogue window.
If prefix argument ARG is non-nil, toggle frozen status."
(defun liece-command-beep (&optional arg)
"Toggle the automatic beep notice when the channel message is received."
(interactive "P")
- (liece-beep (if liece-channel-buffer-mode
- liece-channel-buffer
- liece-dialogue-buffer)
- (if arg (prefix-numeric-value arg))))
+ (liece-set-beep (if liece-channel-buffer-mode
+ liece-channel-buffer
+ liece-dialogue-buffer)
+ (if arg (prefix-numeric-value arg))))
(defun liece-command-quit (&optional arg)
"Quit IRC.
(if (and arg (not (string-equal arg "")))
(liece-command-join arg))
(liece-set-channel-indicator)
- (liece-set-crypt-indicator)
;; refresh mode line
(force-mode-line-update))
(setq liece-current-chat-partner chnl)
(liece-set-channel-indicator))
(save-excursion
- (run-hook-with-args 'liece-redisplay-buffer-functions chnl))
- (liece-set-crypt-indicator)
- t)
+ (run-hook-with-args 'liece-redisplay-buffer-functions chnl)))
(defun liece-switch-to-channel-no (num)
"Switch the current channel to NUM."
(setq liece-current-channel chnl)
(liece-set-channel-indicator))
(save-excursion
- (run-hook-with-args 'liece-redisplay-buffer-functions chnl))
- (liece-set-crypt-indicator)
- t)
- (message "Invalid channel!")
- nil)))
+ (run-hook-with-args 'liece-redisplay-buffer-functions chnl)))
+ (message "Invalid channel!"))))
(defun liece-command-ping ()
"Send PING to server."
+++ /dev/null
-;;; liece-crypt.el --- Encryption/Decryption facility for conversation.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Revised: 1999-02-07
-;; Keywords: IRC, liece
-
-;; This file is part of Liece.
-
-;; 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, 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 GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-
-;;; Commentary:
-;;
-
-;;; Code:
-
-(eval-when-compile
- (require 'liece-inlines)
- (require 'liece-misc))
-
-(autoload 'crc32-string "crc32")
-
-(defgroup liece-crypt nil
- "Crypt customization group"
- :tag "Crypt"
- :prefix "liece-"
- :group 'liece)
-
-(defcustom liece-crypt-decryption-keys nil
- "String list containing decryption keys. e.g. '(\"foo\" \"bar\")."
- :type '(repeat (string :tag "Key"))
- :group 'liece-crypt)
-
-(defcustom liece-crypt-encryption-keys nil
- "List containing pairs of addresses and associated default keys."
- :type '(repeat (cons (string :tag "Channel")
- (string :tag "key")))
- :group 'liece-crypt)
-
-(defcustom liece-crypt-timestamp-tolerance 300
- "Allow incoming messages to have N seconds old timestamp."
- :type 'integer
- :group 'liece-crypt)
-
-(defcustom liece-crypt-default-cipher-algorithm 'idea
- "Cipher algorithm."
- :group 'liece-crypt)
-
-(defcustom liece-crypt-default-hash-function
- (function liece-crypt-hash-crc32-string)
- "Cipher algorithm."
- :type 'function
- :group 'liece-crypt)
-
-(defconst liece-crypt-encrypt-message-format "|*E*|%s|%s|%s|%s|")
-
-(defvar liece-crypt-mode-active nil
- "If t, liece encrypts all messages it has a default key for.")
-
-(defun liece-crypt-encrypted-message-p (message)
- (string-match "^|\\*E\\*|[^|]*|[0-9][0-9]*\\.[0-9][0-9]*|[^|]*|[^|]*|$"
- message))
-
-(defun liece-crypt-hash-crc32-string (string)
- (let ((r (make-string 9 0)) (s (make-string 9 0)))
- (aset r 8 0)
- (aset r 7 (logand (nth 0 string) 255))
- (aset r 6 (logand (lsh (nth 0 string) -8) 255))
- (aset r 5 (logand (nth 1 string) 255))
- (aset r 4 (logand (lsh (nth 1 string) -8) 255))
- (aset r 3 (logand (nth 2 string) 255))
- (aset r 2 (logand (lsh (nth 2 string) -8) 255))
- (aset r 1 (logand (nth 3 string) 255))
- (aset r 0 (logand (lsh (nth 3 string) -8) 255))
- (aset s 8 255)
- (aset s 7 (logand (nth 4 string) 255))
- (aset s 6 (logand (lsh (nth 4 string) -8) 255))
- (aset s 5 (logand (nth 5 string) 255))
- (aset s 4 (logand (lsh (nth 5 string) -8) 255))
- (aset s 3 (logand (nth 6 string) 255))
- (aset s 2 (logand (lsh (nth 6 string) -8) 255))
- (aset s 1 (logand (nth 7 string) 255))
- (aset s 0 (logand (lsh (nth 7 string) -8) 255))
- (setq s (concat (crc32-string (concat r s)) s))
- (setq r (concat (crc32-string (concat s r)) r))
- (substring (crc32-string r) 0 6)
- (substring (crc32-string s) 0 6)))
-
-(defun liece-crypt-key-fingerprint (key &optional algorithm)
- (let* ((algorithm (or algorithm liece-crypt-default-cipher-algorithm))
- (func (intern (concat (symbol-name algorithm)
- "-key-fingerprint"))))
- (if (fboundp func)
- (funcall (symbol-function func) key)
- (funcall liece-crypt-default-hash-function key))))
-
-(defun liece-crypt-algorithm-major-version (&optional algorithm)
- (let ((algorithm (or algorithm liece-crypt-default-cipher-algorithm))
- (major (intern (concat (symbol-name algorithm) "-major-version"))))
- (if (boundp major)
- (symbol-value major))))
-
-(defun liece-crypt-algorithm-minor-version (&optional algorithm)
- (let ((algorithm (or algorithm liece-crypt-default-cipher-algorithm))
- (minor (intern (concat (symbol-name algorithm) "-minor-version"))))
- (if (boundp minor)
- (symbol-value minor))))
-
-(defun liece-crypt-build-decryption-key (key &optional algorithm)
- (let* ((algorithm (or algorithm liece-crypt-default-cipher-algorithm))
- (func (symbol-function
- (intern (concat (symbol-name algorithm)
- "-build-decryption-key")))))
- (funcall func key)))
-
-(defun liece-crypt-build-encryption-key (key &optional algorithm)
- (let* ((algorithm (or algorithm liece-crypt-default-cipher-algorithm))
- (func (symbol-function
- (intern (concat (symbol-name algorithm)
- "-build-encryption-key")))))
- (funcall func key)))
-
-(defun liece-crypt-decrypt-string (string key &optional algorithm mode)
- (let* ((algorithm (or algorithm liece-crypt-default-cipher-algorithm))
- (mode (or mode "cbc"))
- (func (intern (format "%s-%s-decrypt-string"
- (symbol-name algorithm)
- mode))))
- (if (fboundp func)
- (funcall (symbol-function func) string key)
- (error (_ "Mode `%s' is not available.") (upcase mode)))))
-
-(defun liece-crypt-encrypt-string (string key &optional algorithm mode)
- (let* ((algorithm (or algorithm liece-crypt-default-cipher-algorithm))
- (mode (or mode "cbc"))
- (func (intern (format "%s-%s-encrypt-string"
- (symbol-name algorithm)
- mode))))
- (if (fboundp func)
- (funcall (symbol-function func) string key)
- (error (_ "Mode `%s' is not available.") (upcase mode)))))
-
-(defun liece-crypt-valid-version-p (algorithm major-version minor-version)
- (let (major minor)
- (setq major (liece-crypt-algorithm-major-version algorithm)
- minor (liece-crypt-algorithm-minor-version algorithm))
- (cond
- ((and major minor)
- (and (= (symbol-value major) major-version)
- (>= (symbol-value minor) minor-version)))
- (t nil))))
-
-(defun liece-crypt-import-cipher-algorithm (algorithm &optional no-error)
- (let ((algorithm (symbol-name algorithm)))
- (or (eval `(featurep ',(intern algorithm)))
- (load algorithm t)
- (unless no-error
- (error (_ "Unknown algorithm `%s'") (upcase algorithm))))))
-
-(defun liece-crypt-initialize ()
- "Initialize crypt variables."
- (let ((keys (copy-sequence liece-crypt-decryption-keys)))
- (setq liece-crypt-decryption-keys nil)
- (dolist (key keys)
- (liece-command-add-decryption-key key)))
- (let ((keys (copy-sequence liece-crypt-encryption-keys)))
- (setq liece-crypt-encryption-keys nil)
- (dolist (key keys)
- (liece-command-set-encryption-key (car key) (cdr key))))
- (liece-crypt-reset-variables))
-
-(defmacro liece-crypt-reset-variables ()
- '(setq liece-message-encrypted-p nil
- liece-message-suspicious-p nil
- liece-message-garbled-p nil
- liece-message-fingerprint nil
- liece-message-timestamp nil))
-
-\f
-;;;###liece-autoload
-(defun liece-set-crypt-indicator ()
- "Set crypt mode indicator."
- (setq liece-crypt-indicator
- (cond ((and liece-crypt-mode-active
- (eq liece-command-buffer-mode 'channel)
- liece-current-channel
- liece-crypt-encryption-keys
- (string-assoc-ignore-case liece-current-channel
- liece-crypt-encryption-keys))
- "C")
- ((and liece-crypt-mode-active
- (eq liece-command-buffer-mode 'chat)
- liece-current-chat-partner
- liece-crypt-encryption-keys
- (string-assoc-ignore-case liece-current-chat-partner
- liece-crypt-encryption-keys))
- "C")
- (liece-crypt-mode-active "c")
- (t "-"))))
-
-;;;###liece-autoload
-(defun liece-command-add-decryption-key (key-var &optional algorithm)
- "Add new KEY to known decryption keys list."
- (interactive
- (let ((passwd-echo ?*))
- (list (read-passwd "Add passphrase: "))))
- (let ((algorithm (or algorithm liece-crypt-default-cipher-algorithm))
- key fingerprint)
- (liece-crypt-import-cipher-algorithm algorithm)
- (setq key (if (stringp key-var)
- (liece-crypt-build-decryption-key key-var)
- key-var)
- fingerprint (liece-crypt-key-fingerprint key))
- (set-alist 'liece-crypt-decryption-keys fingerprint key)
- (when (interactive-p)
- (liece-message (_ "Added new decryption key (%s).") fingerprint))))
-
-;;;###liece-autoload
-(defun liece-command-delete-decryption-key (key-var &optional algorithm)
- "Delete a KEY from known decryption keys list."
- (interactive
- (let ((passwd-echo ?*))
- (list (read-passwd (_ "Delete passphrase: ")))))
- (let ((algorithm (or algorithm liece-crypt-default-cipher-algorithm))
- fingerprint)
- (liece-crypt-import-cipher-algorithm algorithm)
- (setq fingerprint (liece-crypt-key-fingerprint key-var))
- (remove-alist 'liece-crypt-decryption-keys fingerprint)
- (when (interactive-p)
- (liece-message (_ "Removed decryption key (%s).") fingerprint))))
-
-;;;###liece-autoload
-(defun liece-command-set-encryption-key
- (addr-var pass-var &optional algorithm)
- "Set a default key for ADDRESS (channel/nick) to be KEY."
- (interactive
- (let ((addr-var
- (liece-minibuffer-completing-default-read
- (_ "Default key for channel/user: ")
- (append liece-nick-alist liece-channel-alist)
- nil nil liece-privmsg-partner))
- pass-var)
- (let ((passwd-echo ?*))
- (setq pass-var (read-passwd (_ "Passphrase: "))))
- (when (string-equal pass-var "")
- (setq pass-var nil))
- (list addr-var pass-var)))
- (let ((algorithm (or algorithm liece-crypt-default-cipher-algorithm))
- (addr-var (upcase addr-var)) ek dk fingerprint)
- (liece-crypt-import-cipher-algorithm algorithm)
- (cond
- ((null pass-var)
- (remove-alist 'liece-crypt-encryption-keys addr-var)
- (liece-message (_ "Removed a default key from \"%s\".")
- addr-var))
- (t
- (setq ek (liece-crypt-build-encryption-key pass-var)
- dk (liece-crypt-build-decryption-key pass-var)
- fingerprint (liece-crypt-key-fingerprint dk))
- (liece-command-add-decryption-key dk)
- (set-alist 'liece-crypt-encryption-keys
- addr-var (list fingerprint ek dk))
- (when (interactive-p)
- (liece-message (_ "Added a default key for \"%s\".") addr-var))
- (liece-set-crypt-indicator)))))
-
-(defun liece-make-encrypted-message (message key &optional algorithm)
- "Build an encrypted message from MESSAGE with KEY."
- (let ((algorithm (or algorithm liece-crypt-default-cipher-algorithm)))
- (format liece-crypt-encrypt-message-format
- (upcase (symbol-name algorithm))
- (let ((major (liece-crypt-algorithm-major-version algorithm))
- (minor (liece-crypt-algorithm-minor-version algorithm)))
- (cond
- ((and major minor)
- (format "%d.%d" major minor))
- (t "1.0")))
- (liece-crypt-key-fingerprint key)
- (liece-crypt-encrypt-string message key algorithm))))
-
-(defun liece-encrypt-message (message address &optional no-clear-text)
- "Encrypt MESSAGE to ADDRESS. NO-CLEAR-TEXT prohibits cleartext output."
- (let ((key
- (caddr
- (assoc-if
- `(lambda (item)
- (string-match (concat "^" (upcase item) "$") (upcase ,address)))
- liece-crypt-encryption-keys)))
- (message (liece-coding-encode-charset-string message)))
- (cond
- ((and no-clear-text (null key))
- (error (_ "No default key associated with \"%s\".") address))
- ((null key) message)
- (t
- (liece-make-encrypted-message
- (format "%s\001%s\001%s"
- (liece-current-nickname)
- (liece-generate-hex-timestamp)
- message)
- key)))))
-
-(defmacro liece-crypt-decrypt-fail (&optional value)
- `(throw 'failed ,value))
-
-(defun liece-decrypt-message (message)
- "Decrypt MESSAGE."
- (if (string-match "^|\\*E\\*|\\([^|]*\\)|\\([0-9][0-9]*\\)\\.\\([0-9][0-9]*\\)|\\([^|]*\\)|\\([^|]*\\)|$" message)
- (let ((algorithm (intern (downcase (substring message
- (match-beginning 1)
- (match-end 1)))))
- (version-major (string-to-number (match-string 2 message)))
- (version-minor (string-to-number (match-string 3 message)))
- (fingerprint (match-string 4 message))
- (msg (match-string 5 message))
- key r)
- (catch 'failed
- (or (liece-crypt-import-cipher-algorithm algorithm 'no-error)
- (liece-crypt-decrypt-fail
- (list 'error nil nil (_ "Unknown algorithm")
- fingerprint)))
- (or (liece-crypt-valid-version-p
- algorithm version-major version-minor)
- (liece-crypt-decrypt-fail
- (list 'error nil nil (_ "Unknown version")
- fingerprint)))
- (or (setq key (cdr (assoc fingerprint liece-crypt-decryption-keys)))
- (liece-crypt-decrypt-fail
- (list 'error nil nil (_ "No key")
- fingerprint)))
- (or (setq r (liece-crypt-decrypt-string msg key))
- (liece-crypt-decrypt-fail
- (list 'error nil nil (_ "Decryption failed")
- fingerprint)))
- (or (string-match "^\\([^\001][^\001]*\\)\001\\([^\001][^\001]*\\)\001\\(.*\\)$" r)
- (liece-crypt-decrypt-fail
- (list 'error nil nil (_ "Invalid cleartext format")
- fingerprint)))
- (list 'success
- (match-string 1 r)
- (match-string 2 r)
- (liece-coding-decode-charset-string (match-string 3 r))
- fingerprint)))
- (list 'error nil nil (_ "Invalid message!") nil)))
-
-(defun liece-crypt-maybe-decrypt-message (message sender)
- (let (head tail clear stat nick time msg fprint warn)
- (when (string-match "^\\([^ ]+\\) :\\(.*\\)" message)
- (setq head (match-string 1 message)
- tail (match-string 2 message))
- (when (liece-crypt-encrypted-message-p tail)
- (setq clear (liece-decrypt-message tail)
- stat (nth 0 clear) ;; 'success or 'error
- nick (nth 1 clear) ;; sender's nick
- time (nth 2 clear) ;; timestamp
- msg (nth 3 clear) ;; cleartext msg
- fprint (nth 4 clear) ;; fingerprint
- warn ""
- liece-message-encrypted-p t
- liece-message-fingerprint fprint
- liece-message-timestamp time)
- ;; Check timestamp and nick here
- (cond
- ((equal 'success stat)
- (setq liece-message-suspicious-p t)
- (or (liece-hex-timestamp-valid
- time liece-crypt-timestamp-tolerance)
- (setq warn (concat warn " [Invalid timestamp!]")))
- (or (liece-nick-equal nick sender)
- (setq warn (format
- "%s [Invalid sender \"%s\" != \"%s\"]"
- warn nick sender))))
- (t
- (setq liece-message-garbled-p t)
- (liece-insert liece-C-buffer
- (format "<%s -> %s> %s [%s]\n"
- sender head tail msg))))
- (setq message (format "%s :%s%s" head msg warn))))
- message))
-
-(defun liece-crypt-maybe-encrypt-message (message addr arg key)
- "Encrypt MESSAGE when `liece-crypt-mode' is active."
- (if (or (and arg addr) key)
- (setq liece-message-encrypted-p t
- message (liece-encrypt-message message addr t))
- (setq liece-message-encrypted-p nil))
- message)
-
-(defmacro with-liece-decryption (args &rest body)
- `(let (liece-message-encrypted-p
- liece-message-suspicious-p
- liece-message-garbled-p
- liece-message-fingerprint
- liece-message-timestamp)
- (setq ,(car args)
- (funcall #'liece-crypt-maybe-decrypt-message ,@args))
- ,@body))
-
-(defmacro with-liece-encryption (args &rest body)
- `(let (liece-message-encrypted-p
- liece-message-suspicious-p
- liece-message-garbled-p
- liece-message-fingerprint
- liece-message-timestamp)
- (setq ,(car args)
- (funcall #'liece-crypt-maybe-encrypt-message ,@args))
- ,@body))
-
-(put 'with-liece-decryption 'lisp-indent-function 1)
-(put 'with-liece-encryption 'lisp-indent-function 1)
-
-(provide 'liece-crypt)
-
-;;; liece-crypt.el ends here
"The current joined channels, \"pretty-printed.\".")
(defvar liece-away-indicator "-")
-(defvar liece-crypt-indicator "-")
(defvar liece-command-buffer-mode-indicator "Channels")
(defvar liece-channel-status-indicator "")
(defvar liece-KILLS-buffer " *KILLS*")
(defvar liece-IGNORED-buffer " *IGNORED*")
(defvar liece-WALLOPS-buffer " *WALLOPS*")
-(defvar liece-CRYPT-buffer " *CRYPT*")
(defvar liece-server-buffer nil)
(defvar liece-K-buffer (list liece-KILLS-buffer)
"A list of buffers where KILL messages to me are sent.")
-(defvar liece-C-buffer (list liece-CRYPT-buffer)
- "A list of buffers where messages that were not decrypted are sent.")
-
(defvar liece-000-buffer
(list liece-dialogue-buffer liece-others-buffer)
"A list of buffers where 000 messages to me are sent.")
(liece-insert-notice (append liece-D-buffer liece-O-buffer)
(concat (substring rest (match-end 0)) "\n"))
(return-from liece-handle-notice-message))
-
- (with-liece-decryption (rest prefix)
- (if (run-hook-with-args-until-success 'liece-notice-cleartext-hook
- prefix rest)
- (return-from liece-handle-notice-message))
+ (if (run-hook-with-args-until-success 'liece-notice-cleartext-hook
+ prefix rest)
+ (return-from liece-handle-notice-message))
- (multiple-value-bind (chnl temp) (liece-split-line rest)
- ;; This is a ctcp reply but contains additional messages
- ;; at the left or/and right side.
- (if (liece-handle-ctcp-message-p temp)
- (setq temp (liece-ctcp-notice prefix temp)))
- (if (liece-handle-message-check-empty temp)
- (return-from liece-handle-notice-message))
-
- ;; Normal message via notice.
- (setq chnl (liece-channel-virtual chnl))
- (let ((liece-message-target chnl)
- (liece-message-speaker prefix)
- (liece-message-type 'notice))
- (liece-display-message temp)))))
+ (multiple-value-bind (chnl temp) (liece-split-line rest)
+ ;; This is a ctcp reply but contains additional messages
+ ;; at the left or/and right side.
+ (if (liece-handle-ctcp-message-p temp)
+ (setq temp (liece-ctcp-notice prefix temp)))
+ (if (liece-handle-message-check-empty temp)
+ (return-from liece-handle-notice-message))
+
+ ;; Normal message via notice.
+ (setq chnl (liece-channel-virtual chnl))
+ (let ((liece-message-target chnl)
+ (liece-message-speaker prefix)
+ (liece-message-type 'notice))
+ (liece-display-message temp))))
(defun* liece-handle-privmsg-message (prefix rest)
(if (liece-handle-message-check-ignored prefix rest)
(return-from liece-handle-privmsg-message))
- (with-liece-decryption (rest prefix)
- (if (run-hook-with-args-until-success 'liece-privmsg-cleartext-hook
- prefix rest)
- (return-from liece-handle-privmsg-message))
+ (if (run-hook-with-args-until-success 'liece-privmsg-cleartext-hook
+ prefix rest)
+ (return-from liece-handle-privmsg-message))
- (multiple-value-bind (chnl temp) (liece-split-line rest)
- (setq temp (or temp ""))
- ;; This is a ctcp request but contains additional messages
- ;; at the left or/and right side.
- (if (liece-handle-ctcp-message-p temp)
- (setq temp (liece-ctcp-message prefix chnl temp)))
- (if (liece-handle-message-check-empty temp)
- (return-from liece-handle-privmsg-message))
+ (multiple-value-bind (chnl temp) (liece-split-line rest)
+ (setq temp (or temp ""))
+ ;; This is a ctcp request but contains additional messages
+ ;; at the left or/and right side.
+ (if (liece-handle-ctcp-message-p temp)
+ (setq temp (liece-ctcp-message prefix chnl temp)))
+ (if (liece-handle-message-check-empty temp)
+ (return-from liece-handle-privmsg-message))
- (setq chnl (liece-channel-virtual chnl))
-
- ; beep
- (if liece-beep-on-bells
- (progn
- (and (string-match "\007" rest) (beep t))
- (if (liece-nick-equal chnl liece-real-nickname)
- (and liece-beep-when-privmsg (beep t))
- (with-current-buffer (if liece-channel-buffer-mode
- (liece-pick-buffer-1 chnl)
- liece-dialogue-buffer)
- (and liece-beep (beep t))))
- (let ((i 0)
- (word (nth 0 liece-beep-words-list)))
- (while word
- (and (string-match word rest) (beep t))
- (setq i (1+ i))
- (setq word (nth i liece-beep-words-list))))))
-
- ;; Append timestamp if we are being away.
- (and (string-equal "A" liece-away-indicator)
- (liece-nick-equal chnl liece-real-nickname)
- (setq temp
- (concat temp " ("
- (funcall liece-format-time-function (current-time))
- ")")))
-
- ;; Normal message.
- (let ((liece-message-target chnl)
- (liece-message-speaker prefix)
- (liece-message-type 'privmsg))
- (liece-display-message temp))
+ (setq chnl (liece-channel-virtual chnl))
- ;; Append to the unread list.
- (let ((item (if (eq liece-command-buffer 'chat)
- liece-current-chat-partner
- liece-current-channel)))
- (if (liece-channel-equal chnl item)
- ()
- (and (liece-channel-unread-p chnl)
- (setq liece-channel-unread-list
- (delete chnl liece-channel-unread-list)))
- (setq liece-channel-unread-list
- (cons chnl liece-channel-unread-list))))
-
- (and (liece-nick-equal chnl liece-real-nickname)
- (not (liece-nick-equal prefix liece-current-chat-partner))
- (liece-message (_ "A private message has arrived from %s")
- prefix)))))
+ (when liece-beep-on-bells
+ (if (string-match "\007" rest)
+ (liece-beep))
+ (if (liece-nick-equal chnl liece-real-nickname)
+ (and liece-beep-when-privmsg (liece-beep))
+ (with-current-buffer (if liece-channel-buffer-mode
+ (liece-pick-buffer-1 chnl)
+ liece-dialogue-buffer)
+ (if liece-beep
+ (liece-beep))))
+ (dolist (word liece-beep-words-list)
+ (if (string-match word rest)
+ (liece-beep))))
+
+ ;; Append timestamp if we are being away.
+ (if (and (string-equal "A" liece-away-indicator)
+ (liece-nick-equal chnl liece-real-nickname))
+ (setq temp
+ (concat temp " ("
+ (funcall liece-format-time-function (current-time))
+ ")")))
+
+ ;; Normal message.
+ (let ((liece-message-target chnl)
+ (liece-message-speaker prefix)
+ (liece-message-type 'privmsg))
+ (liece-display-message temp))
+
+ ;; Append to the unread list.
+ (let ((item (if (eq liece-command-buffer 'chat)
+ liece-current-chat-partner
+ liece-current-channel)))
+ (unless (liece-channel-equal chnl item)
+ (if (liece-channel-unread-p chnl)
+ (setq liece-channel-unread-list
+ (delete chnl liece-channel-unread-list)))
+ (setq liece-channel-unread-list
+ (cons chnl liece-channel-unread-list))))
+
+ (if (and (liece-nick-equal chnl liece-real-nickname)
+ (not (liece-nick-equal prefix liece-current-chat-partner)))
+ (liece-message (_ "A private message has arrived from %s")
+ prefix))))
(defun liece-handle-ping-message (prefix rest)
(liece-send "PONG :%s" rest)
(or (string-match " +:" rest)
(return-from liece-handle-invite-message))
(and liece-beep-when-invited liece-beep-on-bells
- (beep t))
+ (liece-beep))
(let ((chnl (liece-channel-virtual (substring rest (match-end 0)))))
(liece-insert-info (append liece-D-buffer liece-O-buffer)
(format "%s invites you to channel %s\n"
["List DCC request" liece-command-dcc-list t]
["Dispatch stacked DCC requests" liece-command-dcc-accept t]))
-(defvar liece-menu-crypt-menu
- '("Crypt"
- ["Toggle crypt mode" liece-command-toggle-crypt t]
- ["Set default key for this channel" liece-command-set-encryption-key
- (or liece-current-channel liece-current-chat-partner)]
- ["Add new key to keyring" liece-command-add-decryption-key t]
- ["Remove key from keyring" liece-command-delete-decryption-key t]))
-
(defvar liece-menu-private-menu
'("Private"
["Toggle private conversation" liece-command-toggle-private
["Display who are on the channel" liece-command-names
(liece-server-opened)]
"----"
- ["Toggle crypt mode" liece-command-toggle-crypt t]
["Set default key of this channel" liece-command-set-default-key
(or liece-current-channel liece-current-chat-partner)]
"----")
(liece-menu-IRC-menu "IRC Menu.")
(liece-menu-channel-menu "Channel Menu.")
(liece-menu-private-menu "Private Menu.")
- (liece-menu-crypt-menu "Crypt Menu.")
(liece-menu-dcc-menu "DCC Menu.")
(liece-menu-url-menu "URL Menu.")))
(defvar liece-menu-IRC-menu-map)
(defvar liece-menu-channel-menu-map)
(defvar liece-menu-private-menu-map)
-(defvar liece-menu-crypt-menu-map)
(defvar liece-menu-dcc-menu-map)
(defvar liece-menu-url-menu-map)
:prefix "liece-"
:group 'liece)
-(defcustom liece-message-blackets
+(defcustom liece-message-brackets
'(((type notice)
("-" "-"))
((and (type action) (direction outgoing))
("(" ")"))
(t
("<" ">")))
- "Blackets."
+ "Brackets."
:group 'liece-message)
(defcustom liece-message-tags
(defvar liece-message-target nil)
(defvar liece-message-speaker nil)
(defvar liece-message-direction nil)
-(defvar liece-message-encrypted-p nil)
-(defvar liece-message-suspicious-p nil)
-(defvar liece-message-garbled-p nil)
-(defvar liece-message-fingerprint nil)
-(defvar liece-message-timestamp nil)
(defun liece-message-predicate (val)
(cond
(t
(liece-eval-form val))))
-(defun liece-message-blackets-function ()
- (let* ((specs liece-message-blackets) spec
- (blackets
+(defun liece-message-brackets-function ()
+ (let* ((specs liece-message-brackets) spec
+ (brackets
(catch 'found
(while specs
(setq spec (pop specs))
(if (liece-message-predicate (car spec))
(throw 'found (cadr spec)))))))
- ;; if message is encrypted just concatenate each blacket, two times.
- (if liece-message-encrypted-p
- (setq blackets (mapcar (function (lambda (b) (concat b b)))
- blackets)))
- blackets))
+ brackets))
(defun liece-message-tags-function ()
(let* ((specs liece-message-tags) spec
;;;###liece-autoload
(defun liece-display-message (temp)
- (let* ((blackets (liece-message-blackets-function))
+ (let* ((brackets (liece-message-brackets-function))
(tags (liece-message-tags-function))
(buffer (liece-message-buffer-function))
(parent (liece-message-parent-buffer buffer)))
(liece-insert buffer
- (concat (car blackets) (car tags) (cadr blackets)
+ (concat (car brackets) (car tags) (cadr brackets)
" " temp "\n"))
(liece-insert parent
- (concat (car blackets) (cadr tags) (cadr blackets)
- " " temp "\n"))
+ (concat (car brackets) (cadr tags) (cadr brackets)
+ " " temp "\n"))
(run-hook-with-args 'liece-display-message-hook temp)))
(provide 'liece-message)
(if liece-display-frame-title
(liece-set-frame-title-format)))
-(defun liece-beep (buffer &optional arg)
+(defun liece-set-beep (buffer &optional arg)
(with-current-buffer buffer
(setq liece-beep (if arg (plusp arg) (not liece-beep))
liece-beep-indicator (if liece-beep "B" "-"))
(force-mode-line-update)))
+(defmacro liece-beep (&optional arg)
+ (list 'funcall 'liece-beep-function arg))
+
(defun liece-freeze (buffer &optional arg)
(with-current-buffer buffer
(setq liece-freeze (if arg (plusp arg) (not liece-freeze))
(setq args (nconc args (list line))))
args))))
-(defmacro liece-message (&rest msg)
+(defmacro liece-message (&rest message)
`(message "%s: %s"
(product-name (product-find 'liece-version))
- (format ,@msg)))
+ (format ,@message)))
(defmacro liece-insert-change (buffer msg)
`(liece-insert ,buffer (concat liece-change-prefix ,msg)))
liece-url
liece-x-face
liece-window
- liece-crypt
liece))
(require 'emu)
:prefix "liece-"
:group 'liece-prefix)
-(defcustom liece-defected-message-prefix ""
- "Prefix to attach before the defected crypt message."
- :type 'string
- :group 'liece-prefix-string)
-
-(defcustom liece-suspicious-message-prefix ""
- "Prefix to attach before the suspicious crypt message."
- :type 'string
- :group 'liece-prefix-string)
-
(defcustom liece-change-prefix "*** Change: "
"String to add before changing messages."
:type 'string
:type '(radio (const :tag "Always" always) (const :tag "No" nil))
:group 'liece-vars)
+(defcustom liece-beep-function 'ding
+ "Function to beep."
+ :type 'function
+ :group 'liece-vars)
+
(defcustom liece-beep-when-invited nil
"If non-nil, beep when invited."
:type 'boolean
(eval-when-compile
(require 'liece-inlines)
(require 'liece-misc)
- (require 'liece-crypt)
(require 'liece-commands))
(autoload 'liece-command-dcc-send "liece-dcc")
:type 'liece-toolbar-icon
:group 'liece-toolbar-icons)
-(defcustom liece-toolbar-crypt-active-icon '(:up "encrypt.xpm")
- "Crypt button (active)."
- :type 'liece-toolbar-icon
- :group 'liece-toolbar-icons)
-
-(defcustom liece-toolbar-crypt-inactive-icon '(:up "crypt.xpm")
- "Crypt button (inactive)."
- :type 'liece-toolbar-icon
- :group 'liece-toolbar-icons)
-
-(defcustom liece-toolbar-crypt-icon
- liece-toolbar-crypt-inactive-icon
- "Crypt button."
- :type 'liece-toolbar-icon
- :group 'liece-toolbar-icons)
-
(defcustom liece-toolbar-stop-icon '(:up "stop.xpm")
"Stop button."
:type 'liece-toolbar-icon
;;; @ internal variables
;;;
(defvar liece-glyph-cache nil)
-(defvar liece-toolbar-position (if (featurep 'toolbar)
- (default-toolbar-position)
- nil))
+(defvar liece-toolbar-position
+ (static-if (featurep 'toolbar)
+ (default-toolbar-position)
+ nil))
(defvar liece-toolbar-back-glyph nil)
(defvar liece-toolbar-forward-glyph nil)
(defvar liece-toolbar-home-glyph nil)
(defvar liece-toolbar-search-glyph nil)
(defvar liece-toolbar-location-glyph nil)
-(defvar liece-toolbar-crypt-glyph nil)
-(defvar liece-toolbar-crypt-active-glyph nil)
-(defvar liece-toolbar-crypt-inactive-glyph nil)
(defvar liece-toolbar-stop-glyph nil)
(defvar liece-toolbar-spec-list
liece-command-finger t "Finger"]
[liece-toolbar-location-glyph
liece-command-join t "Join Channel"]
- [liece-toolbar-crypt-glyph
- liece-toolbar-toggle-crypt t "Toggle Crypt Mode"]
[liece-toolbar-stop-glyph
liece-command-quit t "Quit IRC"]))
(set icon (liece-toolbar-map-button-list plist))))
(run-hooks 'liece-xemacs-setup-toolbar-hook)))
-(add-hook 'liece-xemacs-setup-toolbar-hook 'liece-toolbar-setup-crypt-glyph)
-
-(defun liece-toolbar-setup-crypt-glyph ()
- "Set crypt icons in two states."
- (setq liece-toolbar-crypt-active-glyph
- (liece-toolbar-map-button-list liece-toolbar-crypt-active-icon)
- liece-toolbar-crypt-inactive-glyph
- (liece-toolbar-map-button-list liece-toolbar-crypt-inactive-icon)))
-
-(defun liece-toolbar-toggle-crypt ()
- "Toolbar button handler for crypt mode."
- (interactive)
- (liece-command-toggle-crypt)
- (setq liece-toolbar-crypt-glyph
- (if liece-crypt-mode-active
- liece-toolbar-crypt-active-glyph
- liece-toolbar-crypt-inactive-glyph))
- (when liece-use-toolbar
- (set-specifier (symbol-value liece-use-toolbar) liece-toolbar-spec-list
- (current-buffer))))
-
;;; @ modeline decoration
;;;
(defun liece-xemacs-hide-modeline ()
(file (liece-xemacs-icon-path
liece-xemacs-channel-balloon-icon))
(glyph (make-glyph (vector 'xpm ':file file)))
- chnl ext)
+ ext)
(multiple-value-bind (chnl) (liece-split-line rest)
(setq chnl (liece-channel-virtual chnl))
(goto-char (point-min))
;;; Code:
(require 'liece-inlines)
-(require 'liece-crypt)
(require 'liece-handle)
(require 'liece-filter)
(require 'liece-hilit)
(defvar liece-nick-mode-map (make-sparse-keymap))
(defvar liece-client-query-map (make-sparse-keymap))
(defvar liece-dcc-map (make-sparse-keymap))
-(defvar liece-crypt-map (make-sparse-keymap))
(defvar liece-friends-map (make-sparse-keymap))
(defvar liece-dialogue-mode-map
(liece-private-buffer liece-dialogue-mode)
(liece-KILLS-buffer)
(liece-IGNORED-buffer)
- (liece-WALLOPS-buffer)
- (liece-CRYPT-buffer liece-dialogue-mode)))
+ (liece-WALLOPS-buffer)))
(eval-and-compile
(dotimes (n 20)
"X" liece-command-ctcp-x-face-from-xbm-file
"U" liece-command-ctcp-userinfo-from-minibuffer)
- (liece-define-keys (liece-crypt-map "%" liece-dialogue-mode-map)
- "t" liece-command-toggle-crypt
- "k" liece-command-set-encryption-key
- "a" liece-command-add-decryption-key
- "d" liece-command-delete-decryption-key)
-
(liece-define-keys (liece-dcc-map "\C-d" liece-dialogue-mode-map)
"s" liece-command-dcc-send
"r" liece-command-dcc-receive
(liece-define-keys liece-command-mode-map
"\r" liece-command-enter-message
- [(meta return)] liece-command-enter-message-opposite-crypt-mode
[tab] liece-command-complete
[(meta control c) >] liece-command-push
[(meta control c) <] liece-command-pop
(erase-buffer))
(sit-for 0))
- (liece-set-crypt-indicator)
- (liece-crypt-initialize)
-
(liece-initialize-buffers)
(liece-configure-windows)
(setq liece-current-channels nil)
(interactive)
(kill-all-local-variables)
- (liece-set-crypt-indicator)
(setq liece-nick-alist (list (list liece-nickname))
major-mode 'liece-command-mode
mode-name "Commands"
mode-line-modified
liece-private-indicator
liece-away-indicator
- liece-crypt-indicator
"-- " liece-current-channel " " liece-real-nickname)))
(liece-suppress-mode-line-format)
(use-local-map liece-command-mode-map)
mode-line-modified
liece-away-indicator
liece-beep-indicator
- liece-crypt-indicator
liece-freeze-indicator
liece-own-freeze-indicator
" " liece-channels-indicator " "))
mode-line-modified
liece-away-indicator
liece-beep-indicator
- liece-crypt-indicator
liece-freeze-indicator
liece-own-freeze-indicator
" "
projects / elisp / liece.git / commitdiff