home *** CD-ROM | disk | FTP | other *** search
/ ftp.eterna.com.au / 2014.06.ftp.eterna.com.au.tar / ftp.eterna.com.au / lisp / zenirc-secure-beta.el < prev   
Lisp/Scheme  |  1998-04-14  |  9KB  |  277 lines
  1. ;;;  zenirc-secure.el -- cryptographically secure privmsgs
  2.  
  3. ;; Copyright (C) 1998 anyone but me.
  4.  
  5. ;; Author: not me.
  6. ;; Keywords: zenirc, secure, IDEA, oink, fuck the NSA
  7. ;; Created: 98-04-14
  8.  
  9. ;; This program is free software; you can redistribute it and/or modify
  10. ;; it under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation; either version 2, or (at your option)
  12. ;; any later version.
  13. ;;
  14. ;; This program is distributed in the hope that it will be useful,
  15. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17. ;; GNU General Public License for more details.
  18. ;;
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with this program; if not, you can either send email to this
  21. ;; program's maintainer or write to: The Free Software Foundation,
  22. ;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
  23.  
  24. ;;; Commentary:
  25.  
  26. ;; usage: /secure [nick]
  27. ;;        /encrypt [nick] [string]
  28.  
  29. ;;; Code:
  30. (require 'zenirc)
  31. (require 'idea)
  32.  
  33. (defvar zenirc-command-secure-hook '(zenirc-secure-initiate))
  34. (defvar zenirc-command-encrypt-hook '(zenirc-secure-encrypt))
  35. (defvar zenirc-ctcp-query-SECURE1-hook '(zenirc-ctcp-query-SECURE1))
  36. (defvar zenirc-ctcp-query-SECURE2-hook '(zenirc-ctcp-query-SECURE2))
  37. (defvar zenirc-ctcp-query-ENCRYPTED-hook '(zenirc-ctcp-query-ENCRYPTED))
  38.  
  39. (defvar zenirc-secure-keys nil 
  40.   "assoc list of nick,key")
  41. (defvar zenirc-secure-pending nil 
  42.   "secure connections waiting for reply from other end,
  43. assoc of nick,half-key")
  44.  
  45. (defun zenirc-secure-install-message-catalogs ()
  46.   (zenirc-lang-define-catalog 'english
  47.    '((secure-usage . "[info] usage: /secure nick\n")
  48.      (secure-already . "[info] there is already a secure channel to %s.\n")
  49.      (secure-pending . "[info] already trying to establish a secure channel to %s.\n")
  50.      (secure-list-start . "[info] current secure channels:\n")
  51.      (secure-pending-start . "[info] pending secure channels:\n")
  52.      (secure-list . "[info]   %s\n")
  53.      (secure-end-list . "[info] (end of list)\n")
  54.      (secure-established . "[inf] secure connection established with %s.\n")
  55.      (secure-not-pending . "[inf] %s trying to complete unasked for secure channel.\n")
  56.      (secure-sent . "[inf] encrypted message sent to %s.\n")
  57.      (secure-message . "ENC|%s|ENC %s\n")
  58.      (secure-bogus-message . "[inf] bogus message from %s.\n")
  59.      (secure-no-channel . "[inf] no encrypted channel to %s.\n")
  60.      )))
  61.  
  62.  
  63. (defun zenirc-secure-initiate (proc parsedcmd)
  64.   "initiate a secure channel with someone"
  65.   (let ((lst (zenirc-parse-words (cdr parsedcmd))))
  66.     (cond ((null lst) (zenirc-secure-display-channels proc))
  67.       ((= (length lst) 1)
  68.        (let ((nick (car lst)))
  69.          (cond ((assoc nick zenirc-secure-keys)
  70.             (zenirc-message proc 'secure-already nick))
  71.            ((assoc nick zenirc-secure-pending)
  72.             (zenirc-message proc 'secure-pending nick))
  73.            (t (let ((half-key (zenirc-secure-make-half-key)))
  74.             (setq zenirc-secure-pending
  75.                   (cons (cons nick half-key) zenirc-secure-pending))
  76.             (process-send-string
  77.              proc
  78.              (concat "PRIVMSG "
  79.                  nick
  80.                  " :\C-a"
  81.                  "SECURE1 "
  82.                  (format "%s" half-key)
  83.                  "\C-a\n")))))))
  84.       (t (zenirc-message proc 'secure-usage)))))
  85.  
  86.  
  87. (defun zenirc-secure-display-channels (proc)
  88.   "show the current established and pending secure channels."
  89.   (zenirc-message proc 'secure-list-start)
  90.   (let ((lst zenirc-secure-keys))
  91.     (while lst
  92.       (zenirc-message proc 'secure-list (caar lst))
  93.       (setq lst (cdr lst))))
  94.   (zenirc-message proc 'secure-end-list)
  95.   (zenirc-message proc 'secure-pending-start)
  96.   (let ((lst zenirc-secure-pending))
  97.     (while lst
  98.       (zenirc-message proc 'secure-list (caar lst))
  99.       (setq lst (cdr lst))))
  100.   (zenirc-message proc 'secure-end-list))
  101.  
  102.  
  103. (defun zenirc-secure-make-half-key ()
  104.   "make half a key"
  105.   ;; lamely, for now.
  106.   (vector (logand ?\xffff (random))
  107.       (logand ?\xffff (random))
  108.       (logand ?\xffff (random))
  109.       (logand ?\xffff (random))
  110.       (logand ?\xffff (random))
  111.       (logand ?\xffff (random))
  112.       (logand ?\xffff (random))
  113.       (logand ?\xffff (random))))
  114.  
  115. (defun zenirc-ctcp-query-SECURE1 (proc parsedctcp from to)
  116.   (if (zenirc-names-equal-p to zenirc-nick)
  117.       (let ((half-key (read (cdr parsedctcp)))
  118.         (nick (zenirc-extract-nick from))
  119.         (other-half (zenirc-secure-make-half-key)))
  120.     (process-send-string proc
  121.                  (concat "PRIVMSG "
  122.                      nick
  123.                      " :\C-a"
  124.                      "SECURE2 "
  125.                      (format "%s" other-half)
  126.                      "\C-a\n"))
  127.     (setq zenirc-secure-keys 
  128.           (cons (cons nick 
  129.               (zenirc-secure-combine-keys half-key
  130.                               other-half))
  131.             zenirc-secure-keys))
  132.     (zenirc-message proc 'secure-established nick))))
  133.  
  134. (defun zenirc-ctcp-query-SECURE2 (proc parsedctcp from to)
  135.   (if (zenirc-names-equal-p to zenirc-nick)
  136.       (let* ((half-key (read (cdr parsedctcp)))
  137.          (nick (zenirc-extract-nick from))
  138.          (pending (assoc nick zenirc-secure-pending)))
  139.     (if (not pending)
  140.         (zenirc-message proc 'secure-not-pending nick)
  141.       (progn
  142.         (setq zenirc-secure-pending 
  143.           (delq pending zenirc-secure-pending))
  144.         (setq zenirc-secure-keys 
  145.           (cons (cons nick
  146.                   (zenirc-secure-combine-keys half-key
  147.                               (cdr pending)))
  148.             zenirc-secure-keys))
  149.         (zenirc-message proc 'secure-established nick))))))
  150.  
  151. (defun zenirc-secure-combine-keys (key1 key2)
  152.   (let ((combined (copy-sequence key1))
  153.     (idx 0)
  154.     (len (length key1)))
  155.     (while (< idx len)
  156.       (aset combined idx (logxor (aref key1 idx)
  157.                  (aref key2 idx)))
  158.       (setq idx (1+ idx)))
  159.     (let ((subkeys (idea-encrypt-subkeys combined)))
  160.       (cons subkeys (idea-decrypt-subkeys subkeys)))))
  161.  
  162.  
  163. (defun zenirc-secure-encrypt (proc parsedcmd)
  164.   (let* ((pair (zenirc-parse-firstword (cdr parsedcmd)))
  165.      (nick (car pair))
  166.      (subkeys (cadr (assoc nick zenirc-secure-keys)))
  167.      (encrypted (and subkeys
  168.              (zenirc-idea-encrypt subkeys (cdr pair)))))
  169.     (if encrypted
  170.     (progn
  171.       (process-send-string proc
  172.                    (concat "PRIVMSG "
  173.                        nick
  174.                        " :\C-a"
  175.                        "ENCRYPTED "
  176.                        encrypted
  177.                        "\C-a\n"))
  178.       (zenirc-message proc 'secure-sent nick))
  179.       (zenirc-message proc 'secure-no-channel nick))))
  180.  
  181.  
  182. (defun zenirc-ctcp-query-ENCRYPTED (proc parsedctcp from to)
  183.   (if (zenirc-names-equal-p to zenirc-nick)
  184.       (let* ((nick (zenirc-extract-nick from))
  185.          (subkeys (cddr (assoc nick zenirc-secure-keys)))
  186.          (decrypted (and subkeys
  187.                  (zenirc-idea-decrypt subkeys (cdr parsedctcp)))))
  188.     (if (not decrypted)
  189.         (zenirc-message proc 'secure-bogus-message nick)
  190.       (zenirc-message proc 'secure-message
  191.               nick
  192.               decrypted)))))
  193.  
  194. (defun zenirc-idea-encrypt (subkeys message)
  195.   ;; seed the message with a random block and the length
  196.   (let* ((len (length message))
  197.      (temp (list len
  198.              (logand ?\xffff (random))
  199.              (logand ?\xffff (random))
  200.              (logand ?\xffff (random))))
  201.      (store nil)
  202.      (idx 0)
  203.      (num-blocks 0)
  204.      ;; pad to a multiple of 4 blocks, 2 chars per block
  205.      (total-blocks (* 4 (/ (+ (/ len 2) 3) 4))))
  206.     (while (< num-blocks total-blocks)
  207.       (let ((this-char (if (< idx len)
  208.                (aref message idx)
  209.              0)))
  210.     (if store
  211.         (progn
  212.           (setq temp (cons (+ store this-char)
  213.                    temp))
  214.           (setq num-blocks (1+ num-blocks))
  215.           (setq store nil))
  216.       (setq store (ash this-char 8)))
  217.  
  218.     (setq idx (1+ idx))))
  219.  
  220.     (let* ((vec (apply #'vector (nreverse temp))))
  221.       (zenirc-secure-idea-run vec subkeys 'forward)
  222.       ;; output as an elisp readable vector
  223.       (format "%s" vec))))
  224.  
  225. (defun zenirc-secure-idea-run (vec subkeys direction)
  226.   (let ((len (length vec))
  227.     (idx 0)
  228.     feedback)
  229.  
  230.     (while (< idx len)
  231.       (let* ((t1 (vector (aref vec (+ 0 idx))
  232.              (aref vec (+ 1 idx))
  233.              (aref vec (+ 2 idx))
  234.              (aref vec (+ 3 idx))))
  235.          (t2 (idea-cipher-block t1 subkeys)))
  236.     
  237.     (let ((i 0))
  238.       (while (< i 4)
  239.         ;; feedback is nil the first time through, even
  240.         ;; when running backward.
  241.         (aset vec (+ i idx) (if feedback
  242.                     (logxor (aref t2 i)
  243.                         (aref feedback i))
  244.                   (aref t2 i)))
  245.         (setq i (1+ i))))
  246.  
  247.     (setq idx (+ idx 4))
  248.  
  249.     (if (eq direction 'backward)
  250.         ;; store off ciphertext for later undoing of feedback
  251.         (setq feedback t1)
  252.       
  253.       ;; feedback in forward direction:
  254.       ;;   cipher(n+1) = cipher(cipher(n) xor plain(n+1))
  255.       (if (< idx len)
  256.           (let ((i 0))
  257.         (while (< i 4)
  258.           (aset vec (+ i idx) (logxor (aref vec (+ i idx))
  259.                           (aref vec (+ i idx -4))))
  260.           (setq i (1+ i))))))))))
  261.       
  262.  
  263. (defun zenirc-idea-decrypt (subkeys message)
  264.   (let ((vec (read message)))
  265.     (zenirc-secure-idea-run vec subkeys 'backward)
  266.     (let ((len (aref vec 3)))
  267.       (substring (mapconcat #'(lambda (x)
  268.                 (concat (char-to-string (ash x -8))
  269.                     (char-to-string (logand ?\xff x))))
  270.                 vec
  271.                 "")
  272.          8 (+ len 8)))))
  273.  
  274. (provide 'zenirc-secure)
  275.  
  276. (zenirc-secure-install-message-catalogs)
  277.